diff --git a/cardano-tracer/CHANGELOG.md b/cardano-tracer/CHANGELOG.md index f9f778d0836..7f3bcd213ef 100644 --- a/cardano-tracer/CHANGELOG.md +++ b/cardano-tracer/CHANGELOG.md @@ -1,5 +1,16 @@ # ChangeLog +## 0.2.4 (July 12, 2024) + +* Put RTView behind a feature flag that is disabled by default. To enable RTView, + use the cabal flag `-f +rtview`. No change to the service configuration. +* EKG monitoring moved from `threepenny-gui` to direct HTML rendering. +* Drop dependency on package `threepenny-gui` (unless RTView is enabled). +* Restructured modules `Cardano.Tracer.Handlers.RTView.Notifications.*` + to `Cardano.Tracer.Handlers.Notifications.*`. +* All modules related to notification, SSL, and others moved from the RTView + namespace. + ## 0.2.3 (April 19, 2024) * The field `rpMaxAgeHours` of `RotationParams` is changed to diff --git a/cardano-tracer/README.md b/cardano-tracer/README.md index 710f33e710e..b791424f3e3 100644 --- a/cardano-tracer/README.md +++ b/cardano-tracer/README.md @@ -6,10 +6,16 @@ For more details please [read the documentation](https://github.com/intersectmbo ## RTView +> Attention: RTView is hidden behind a build flag. Enable with this cabal flag: `-f +rtview`. + RTView is a real-time monitoring tool for Cardano nodes (RTView is an abbreviation for "Real Time View"), it is a part of `cardano-tracer` service. RTView provides an interactive web page where you can see different kinds of information about connected nodes (something like Grafana). For more details please [read its documentation](https://github.com/intersectmbo/cardano-node/blob/master/cardano-tracer/docs/cardano-rtview.md). +RTView is not feature complete and is thus disabled by default. Being +an experimental/optional component of `cardano-tracer` we will still +guarantee it remains buildable and usable in its current state. + ## Developers Performance and Tracing team is responsible for this service. The primary developer is [Baldur Blöndal](https://github.com/Icelandjack). diff --git a/cardano-tracer/app/cardano-tracer.hs b/cardano-tracer/app/cardano-tracer.hs index b941349fbe4..63ba7678dae 100644 --- a/cardano-tracer/app/cardano-tracer.hs +++ b/cardano-tracer/app/cardano-tracer.hs @@ -9,13 +9,19 @@ import Paths_cardano_tracer (version) main :: IO () main = runCardanoTracer =<< customExecParser (prefs showHelpOnEmpty) tracerInfo - where - tracerInfo :: ParserInfo TracerParams - tracerInfo = info - (parseTracerParams <**> helper <**> versionOption) - (fullDesc <> header "cardano-tracer - the logging and monitoring service for Cardano nodes.") - versionOption = infoOption - (showVersion version) - (long "version" <> - short 'v' <> - help "Show version") + +tracerInfo :: ParserInfo TracerParams +tracerInfo = info + (parseTracerParams <**> helper <**> versionOption) +#if RTVIEW + (fullDesc <> header "cardano-tracer/with RTView - the logging and monitoring service for Cardano nodes.") +#else + (fullDesc <> header "cardano-tracer/without RTView - the logging and monitoring service for Cardano nodes.") +#endif + +versionOption :: Parser (a -> a) +versionOption = infoOption + (showVersion version) + (long "version" <> + short 'v' <> + help "Show version") diff --git a/cardano-tracer/bench/cardano-tracer-bench.hs b/cardano-tracer/bench/cardano-tracer-bench.hs index 3bb9b737116..9fb1bd3d75a 100644 --- a/cardano-tracer/bench/cardano-tracer-bench.hs +++ b/cardano-tracer/bench/cardano-tracer-bench.hs @@ -5,14 +5,18 @@ import Cardano.Logging hiding (LocalSocket) import Cardano.Tracer.Configuration import Cardano.Tracer.Environment import Cardano.Tracer.Handlers.Logs.TraceObjects +#if RTVIEW import Cardano.Tracer.Handlers.RTView.Run import Cardano.Tracer.Handlers.RTView.State.Historical +#endif import Cardano.Tracer.MetaTrace import Cardano.Tracer.Types import Cardano.Tracer.Utils import Control.Concurrent.Extra (newLock) +#if RTVIEW import Control.Concurrent.STM.TVar (newTVarIO) +#endif import Control.DeepSeq import qualified Data.List.NonEmpty as NE import Data.Time.Clock (UTCTime, getCurrentTime) @@ -36,45 +40,54 @@ main = do connectedNodes <- initConnectedNodes connectedNodesNames <- initConnectedNodesNames acceptedMetrics <- initAcceptedMetrics +#if RTVIEW savedTO <- initSavedTraceObjects chainHistory <- initBlockchainHistory resourcesHistory <- initResourcesHistory txHistory <- initTransactionsHistory +#endif protocolsBrake <- initProtocolsBrake dpRequestors <- initDataPointRequestors currentLogLock <- newLock currentDPLock <- newLock +#if RTVIEW eventsQueues <- initEventsQueues Nothing connectedNodesNames dpRequestors currentDPLock rtViewPageOpened <- newTVarIO False +#endif + + tracer <- mkTracerTracer $ SeverityF $ Just Warning + + let tracerEnv :: TracerConfig -> HandleRegistry -> TracerEnv + tracerEnv config handleRegistry = TracerEnv + { teConfig = config + , teConnectedNodes = connectedNodes + , teConnectedNodesNames = connectedNodesNames + , teAcceptedMetrics = acceptedMetrics + , teCurrentLogLock = currentLogLock + , teCurrentDPLock = currentDPLock + , teDPRequestors = dpRequestors + , teProtocolsBrake = protocolsBrake + , teTracer = tracer + , teReforwardTraceObjects = \_-> pure () + , teRegistry = handleRegistry + , teStateDir = Nothing + } - tr <- mkTracerTracer $ SeverityF $ Just Warning - - let te :: TracerConfig -> HandleRegistry -> TracerEnv - te c r = - TracerEnv - { teConfig = c - , teConnectedNodes = connectedNodes - , teConnectedNodesNames = connectedNodesNames - , teAcceptedMetrics = acceptedMetrics - , teSavedTO = savedTO - , teBlockchainHistory = chainHistory - , teResourcesHistory = resourcesHistory - , teTxHistory = txHistory - , teCurrentLogLock = currentLogLock - , teCurrentDPLock = currentDPLock - , teEventsQueues = eventsQueues - , teDPRequestors = dpRequestors - , teProtocolsBrake = protocolsBrake - , teRTViewPageOpened = rtViewPageOpened - , teRTViewStateDir = Nothing - , teTracer = tr - , teReforwardTraceObjects = \_-> pure () - , teRegistry = r - } + tracerEnvRTView :: TracerEnvRTView + tracerEnvRTView = TracerEnvRTView +#if RTVIEW + { teSavedTO = savedTO + , teBlockchainHistory = chainHistory + , teResourcesHistory = resourcesHistory + , teTxHistory = txHistory + , teEventsQueues = eventsQueues + , teRTViewPageOpened = rtViewPageOpened + } +#endif removePathForcibly root @@ -82,18 +95,21 @@ main = do myBench :: TracerConfig -> [TraceObject] -> Benchmarkable myBench config traceObjects = let - action :: IO TracerEnv - action = te config <$> newRegistry + initialise :: IO TracerEnv + initialise = + tracerEnv config <$> newRegistry cleanup :: TracerEnv -> IO () - cleanup TracerEnv{teRegistry} = clearRegistry teRegistry + cleanup TracerEnv{teRegistry} = + clearRegistry teRegistry benchmark :: TracerEnv -> IO () - benchmark traceEnv = beforeProgramStops do - traceObjectsHandler traceEnv nId traceObjects + benchmark trEnv = do + beforeProgramStops do + traceObjectsHandler trEnv tracerEnvRTView nId traceObjects in - perRunEnvWithCleanup @TracerEnv action cleanup benchmark + perRunEnvWithCleanup @TracerEnv initialise cleanup benchmark now <- getCurrentTime diff --git a/cardano-tracer/cardano-tracer.cabal b/cardano-tracer/cardano-tracer.cabal index 69816d0fff6..0de550861fd 100644 --- a/cardano-tracer/cardano-tracer.cabal +++ b/cardano-tracer/cardano-tracer.cabal @@ -1,7 +1,7 @@ cabal-version: 3.0 name: cardano-tracer -version: 0.2.3 +version: 0.2.4 synopsis: A service for logging and monitoring over Cardano nodes description: A service for logging and monitoring over Cardano nodes. category: Cardano, @@ -16,6 +16,11 @@ build-type: Simple extra-doc-files: README.md CHANGELOG.md +flag rtview + Description: Enable RTView. False by default. Enable with `-f +rtview`. + Default: False + Manual: True + common project-config default-language: Haskell2010 build-depends: base >= 4.14 && < 5 @@ -27,8 +32,12 @@ common project-config , ImportQualifiedPost , InstanceSigs , ScopedTypeVariables + , StandaloneKindSignatures , TypeApplications + if flag(rtview) + CPP-Options: -DRTVIEW=1 + ghc-options: -Wall -Wcompat -Wincomplete-record-updates @@ -42,46 +51,18 @@ common project-config library import: project-config - hs-source-dirs: src - - exposed-modules: Cardano.Tracer.Acceptors.Client - Cardano.Tracer.Acceptors.Run - Cardano.Tracer.Acceptors.Server - Cardano.Tracer.Acceptors.Utils - - Cardano.Tracer.Handlers.Logs.File - Cardano.Tracer.Handlers.Logs.Journal - Cardano.Tracer.Handlers.Logs.Rotator - Cardano.Tracer.Handlers.Logs.TraceObjects - Cardano.Tracer.Handlers.Logs.Utils - Cardano.Tracer.Handlers.Metrics.Monitoring - Cardano.Tracer.Handlers.Metrics.Prometheus - Cardano.Tracer.Handlers.Metrics.Servers - Cardano.Tracer.Handlers.Metrics.Utils - - Cardano.Tracer.Handlers.ReForwarder - - Cardano.Tracer.Handlers.RTView.Notifications.Check - Cardano.Tracer.Handlers.RTView.Notifications.Email - Cardano.Tracer.Handlers.RTView.Notifications.Send - Cardano.Tracer.Handlers.RTView.Notifications.Settings - Cardano.Tracer.Handlers.RTView.Notifications.Timer - Cardano.Tracer.Handlers.RTView.Notifications.Types - Cardano.Tracer.Handlers.RTView.Notifications.Utils - - Cardano.Tracer.Handlers.RTView.Run + hs-source-dirs: src - Cardano.Tracer.Handlers.RTView.SSL.Certs + if flag(rtview) + exposed-modules: Cardano.Tracer.Handlers.RTView.Run + Cardano.Tracer.Handlers.RTView.Utils Cardano.Tracer.Handlers.RTView.State.Displayed Cardano.Tracer.Handlers.RTView.State.EraSettings Cardano.Tracer.Handlers.RTView.State.Historical Cardano.Tracer.Handlers.RTView.State.Last Cardano.Tracer.Handlers.RTView.State.Peers - Cardano.Tracer.Handlers.RTView.State.TraceObjects - - Cardano.Tracer.Handlers.RTView.System Cardano.Tracer.Handlers.RTView.UI.CSS.Bulma Cardano.Tracer.Handlers.RTView.UI.CSS.Own @@ -119,9 +100,36 @@ library Cardano.Tracer.Handlers.RTView.Update.Reload Cardano.Tracer.Handlers.RTView.Update.Resources Cardano.Tracer.Handlers.RTView.Update.Transactions - Cardano.Tracer.Handlers.RTView.Update.Utils - Cardano.Tracer.Handlers.RTView.Utils + exposed-modules: Cardano.Tracer.Acceptors.Client + Cardano.Tracer.Acceptors.Run + Cardano.Tracer.Acceptors.Server + Cardano.Tracer.Acceptors.Utils + + Cardano.Tracer.Handlers.Logs.File + Cardano.Tracer.Handlers.Logs.Journal + Cardano.Tracer.Handlers.Logs.Rotator + Cardano.Tracer.Handlers.Logs.TraceObjects + Cardano.Tracer.Handlers.Logs.Utils + + Cardano.Tracer.Handlers.Metrics.Monitoring + Cardano.Tracer.Handlers.Metrics.Prometheus + Cardano.Tracer.Handlers.Metrics.Servers + Cardano.Tracer.Handlers.Metrics.Utils + + Cardano.Tracer.Handlers.Notifications.Check + Cardano.Tracer.Handlers.Notifications.Email + Cardano.Tracer.Handlers.Notifications.Send + Cardano.Tracer.Handlers.Notifications.Settings + Cardano.Tracer.Handlers.Notifications.Timer + Cardano.Tracer.Handlers.Notifications.Types + Cardano.Tracer.Handlers.Notifications.Utils + + Cardano.Tracer.Handlers.ReForwarder + Cardano.Tracer.Handlers.SSL.Certs + Cardano.Tracer.Handlers.State.TraceObjects + Cardano.Tracer.Handlers.System + Cardano.Tracer.Handlers.Utils Cardano.Tracer.CLI Cardano.Tracer.Configuration @@ -134,19 +142,23 @@ library other-modules: Paths_cardano_tracer autogen-modules: Paths_cardano_tracer + if flag(rtview) + build-depends: + cardano-git-rev ^>=0.2.2 + , cassava + , threepenny-gui + , vector + build-depends: aeson , async , async-extras , bimap , blaze-html , bytestring - , cardano-git-rev ^>=0.2.2 , cardano-node - , cassava , cborg , containers , contra-tracer - , cryptonite , directory , ekg , ekg-core @@ -166,21 +178,20 @@ library , stm , string-qq , text - , threepenny-gui , time , trace-dispatcher , trace-forward , trace-resources , unordered-containers - , vector , yaml if os(linux) build-depends: libsystemd-journal >= 1.4.4 + if os(windows) - build-depends: Win32 + build-depends: Win32 else - build-depends: unix + build-depends: unix executable cardano-tracer import: project-config @@ -412,13 +423,14 @@ benchmark cardano-tracer-bench main-is: cardano-tracer-bench.hs + if flag(rtview) + build-depends: stm build-depends: cardano-tracer , criterion , directory , deepseq , extra , filepath - , stm , time , trace-dispatcher diff --git a/cardano-tracer/docs/cardano-rtview.md b/cardano-tracer/docs/cardano-rtview.md index 407ecbbbf00..7ecc2bcbef3 100644 --- a/cardano-tracer/docs/cardano-rtview.md +++ b/cardano-tracer/docs/cardano-rtview.md @@ -1,6 +1,12 @@ # Cardano RTView -RTView is a part of `cardano-tracer` [service](https://github.com/intersectmbo/cardano-node/blob/master/cardano-tracer/docs/cardano-tracer.md). It is a real-time monitoring tool for Cardano nodes (RTView is an abbreviation for "Real Time View"). It provides an interactive web page where you can see different kinds of information about connected nodes. +> Attention: RTView is hidden behind a build flag. Enable with this cabal flag: `-f +rtview`. + +RTView is an optional part of `cardano-tracer` [service](https://github.com/intersectmbo/cardano-node/blob/master/cardano-tracer/docs/cardano-tracer.md). It is a real-time monitoring tool for Cardano nodes (RTView is an abbreviation for "Real Time View"). It provides an interactive web page where you can see different kinds of information about connected nodes. + +RTView is not feature complete and is thus disabled by default. Being +an experimental/optional component of `cardano-tracer` we will still +guarantee it remains buildable and usable in its current state. # Contents diff --git a/cardano-tracer/src/Cardano/Tracer/Acceptors/Client.hs b/cardano-tracer/src/Cardano/Tracer/Acceptors/Client.hs index 61d0019fc8c..deff7407fd1 100644 --- a/cardano-tracer/src/Cardano/Tracer/Acceptors/Client.hs +++ b/cardano-tracer/src/Cardano/Tracer/Acceptors/Client.hs @@ -7,8 +7,13 @@ module Cardano.Tracer.Acceptors.Client import Cardano.Logging (TraceObject) import Cardano.Logging.Version (ForwardingVersion (..), ForwardingVersionData (..), forwardingCodecCBORTerm, forwardingVersionCodec) +#if RTVIEW import Cardano.Tracer.Acceptors.Utils (notifyAboutNodeDisconnected, prepareDataPointRequestor, prepareMetricsStores, removeDisconnectedNode) +#else +import Cardano.Tracer.Acceptors.Utils ( + prepareDataPointRequestor, prepareMetricsStores, removeDisconnectedNode) +#endif import qualified Cardano.Tracer.Configuration as TC import Cardano.Tracer.Environment import Cardano.Tracer.Handlers.Logs.TraceObjects (deregisterNodeId, traceObjectsHandler) @@ -45,13 +50,14 @@ import Trace.Forward.Run.TraceObject.Acceptor (acceptTraceObjectsInit) runAcceptorsClient :: TracerEnv + -> TracerEnvRTView -> FilePath -> ( EKGF.AcceptorConfiguration , TF.AcceptorConfiguration TraceObject , DPF.AcceptorConfiguration ) -> IO () -runAcceptorsClient tracerEnv p (ekgConfig, tfConfig, dpfConfig) = withIOManager $ \iocp -> do +runAcceptorsClient tracerEnv tracerEnvRTView p (ekgConfig, tfConfig, dpfConfig) = withIOManager \iocp -> do traceWith (teTracer tracerEnv) $ TracerSockConnecting p doConnectToForwarder (localSnocket iocp) @@ -62,7 +68,7 @@ runAcceptorsClient tracerEnv p (ekgConfig, tfConfig, dpfConfig) = withIOManager -- there is no mechanism to disable some of them. appInitiator [ (runEKGAcceptorInit tracerEnv ekgConfig errorHandler, 1) - , (runTraceObjectsAcceptorInit tracerEnv tfConfig errorHandler, 2) + , (runTraceObjectsAcceptorInit tracerEnv tracerEnvRTView tfConfig errorHandler, 2) , (runDataPointsAcceptorInit tracerEnv dpfConfig errorHandler, 3) ] where @@ -78,7 +84,9 @@ runAcceptorsClient tracerEnv p (ekgConfig, tfConfig, dpfConfig) = withIOManager errorHandler connId = do deregisterNodeId tracerEnv (connIdToNodeId connId) removeDisconnectedNode tracerEnv connId - notifyAboutNodeDisconnected tracerEnv connId +#if RTVIEW + notifyAboutNodeDisconnected tracerEnvRTView connId +#endif doConnectToForwarder :: Snocket IO LocalSocket LocalAddress @@ -124,16 +132,17 @@ runEKGAcceptorInit tracerEnv ekgConfig errorHandler = runTraceObjectsAcceptorInit :: TracerEnv + -> TracerEnvRTView -> TF.AcceptorConfiguration TraceObject -> (ConnectionId LocalAddress -> IO ()) -> RunMiniProtocol 'InitiatorMode (MinimalInitiatorContext LocalAddress) responderCtx LBS.ByteString IO () Void -runTraceObjectsAcceptorInit tracerEnv tfConfig errorHandler = +runTraceObjectsAcceptorInit tracerEnv tracerEnvRTView tfConfig errorHandler = acceptTraceObjectsInit tfConfig - (traceObjectsHandler tracerEnv . connIdToNodeId . micConnectionId) + (traceObjectsHandler tracerEnv tracerEnvRTView . connIdToNodeId . micConnectionId) (errorHandler . micConnectionId) runDataPointsAcceptorInit diff --git a/cardano-tracer/src/Cardano/Tracer/Acceptors/Run.hs b/cardano-tracer/src/Cardano/Tracer/Acceptors/Run.hs index 9b60c20e659..a628a6b257d 100644 --- a/cardano-tracer/src/Cardano/Tracer/Acceptors/Run.hs +++ b/cardano-tracer/src/Cardano/Tracer/Acceptors/Run.hs @@ -29,23 +29,23 @@ import qualified Trace.Forward.Protocol.TraceObject.Type as TOF -- There are two "network modes" for acceptors: -- 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 -> IO () -runAcceptors tracerEnv@TracerEnv{teTracer} = do +runAcceptors :: TracerEnv -> TracerEnvRTView -> IO () +runAcceptors tracerEnv@TracerEnv{teTracer} tracerEnvRTView = do traceWith teTracer $ TracerStartedAcceptors network case network of AcceptAt (LocalSocket p) -> -- Run one server that accepts connections from the nodes. runInLoop - (runAcceptorsServer tracerEnv p $ acceptorsConfigs p) + (runAcceptorsServer tracerEnv tracerEnvRTView p $ acceptorsConfigs p) verbosity p initialPauseInSec ConnectTo localSocks -> -- Run N clients that initiate connections to the nodes. forConcurrently_ (NE.nub localSocks) $ \(LocalSocket p) -> runInLoop - (runAcceptorsClient tracerEnv p $ acceptorsConfigs p) + (runAcceptorsClient tracerEnv tracerEnvRTView p $ acceptorsConfigs p) verbosity p initialPauseInSec where - TracerConfig{network, ekgRequestFreq, loRequestNum, verbosity} = teConfig tracerEnv + TracerConfig{network, ekgRequestFreq, verbosity} = teConfig tracerEnv acceptorsConfigs p = ( EKGF.AcceptorConfiguration @@ -58,7 +58,7 @@ runAcceptors tracerEnv@TracerEnv{teTracer} = do , TOF.AcceptorConfiguration { TOF.acceptorTracer = mkVerbosity verbosity , TOF.forwarderEndpoint = p - , TOF.whatToRequest = TOF.NumberOfTraceObjects $ fromMaybe 100 loRequestNum + , TOF.whatToRequest = TOF.NumberOfTraceObjects $ fromMaybe 100 (loRequestNum (teConfig tracerEnv)) , TOF.shouldWeStop = teProtocolsBrake tracerEnv } , DPF.AcceptorConfiguration diff --git a/cardano-tracer/src/Cardano/Tracer/Acceptors/Server.hs b/cardano-tracer/src/Cardano/Tracer/Acceptors/Server.hs index 18ed43da934..efd81ab65c2 100644 --- a/cardano-tracer/src/Cardano/Tracer/Acceptors/Server.hs +++ b/cardano-tracer/src/Cardano/Tracer/Acceptors/Server.hs @@ -9,8 +9,13 @@ module Cardano.Tracer.Acceptors.Server import Cardano.Logging (TraceObject) import Cardano.Logging.Version (ForwardingVersion (..), ForwardingVersionData (..), forwardingCodecCBORTerm, forwardingVersionCodec) +#if RTVIEW import Cardano.Tracer.Acceptors.Utils (notifyAboutNodeDisconnected, prepareDataPointRequestor, prepareMetricsStores, removeDisconnectedNode) +#else +import Cardano.Tracer.Acceptors.Utils (prepareDataPointRequestor, prepareMetricsStores, + removeDisconnectedNode) +#endif import qualified Cardano.Tracer.Configuration as TC import Cardano.Tracer.Environment import Cardano.Tracer.Handlers.Logs.TraceObjects (deregisterNodeId, traceObjectsHandler) @@ -50,13 +55,15 @@ import Trace.Forward.Run.TraceObject.Acceptor (acceptTraceObjectsResp) runAcceptorsServer :: TracerEnv + -> TracerEnvRTView -> FilePath -> ( EKGF.AcceptorConfiguration , TF.AcceptorConfiguration TraceObject , DPF.AcceptorConfiguration ) -> IO () -runAcceptorsServer tracerEnv p (ekgConfig, tfConfig, dpfConfig) = withIOManager $ \iocp -> do +runAcceptorsServer tracerEnv tracerEnvRTView p ( ekgConfig, tfConfig, dpfConfig) = + withIOManager \iocp -> do traceWith (teTracer tracerEnv) $ TracerSockListen p doListenToForwarder (localSnocket iocp) @@ -67,7 +74,7 @@ runAcceptorsServer tracerEnv p (ekgConfig, tfConfig, dpfConfig) = withIOManager -- there is no mechanism to disable some of them. appResponder [ (runEKGAcceptor tracerEnv ekgConfig errorHandler, 1) - , (runTraceObjectsAcceptor tracerEnv tfConfig errorHandler, 2) + , (runTraceObjectsAcceptor tracerEnv tracerEnvRTView tfConfig errorHandler, 2) , (runDataPointsAcceptor tracerEnv dpfConfig errorHandler, 3) ] where @@ -83,7 +90,9 @@ runAcceptorsServer tracerEnv p (ekgConfig, tfConfig, dpfConfig) = withIOManager errorHandler connId = do deregisterNodeId tracerEnv (connIdToNodeId connId) removeDisconnectedNode tracerEnv connId - notifyAboutNodeDisconnected tracerEnv connId +#if RTVIEW + notifyAboutNodeDisconnected tracerEnvRTView connId +#endif doListenToForwarder :: Snocket IO LocalSocket LocalAddress @@ -97,26 +106,26 @@ doListenToForwarder -> IO () doListenToForwarder snocket address netMagic timeLimits app = do networkState <- newNetworkMutableState - race_ (cleanNetworkMutableState networkState) - $ withServerNode - snocket - makeLocalBearer - mempty -- LocalSocket does not need to be configured - nullNetworkServerTracers - networkState - (AcceptedConnectionsLimit maxBound maxBound 0) - address - (codecHandshake forwardingVersionCodec) - timeLimits - (cborTermVersionDataCodec forwardingCodecCBORTerm) - (HandshakeCallbacks acceptableVersion queryVersion) - (simpleSingletonVersions - ForwardingV_1 - (ForwardingVersionData $ NetworkMagic netMagic) - (SomeResponderApplication app) - ) - nullErrorPolicies - $ \_ serverAsync -> wait serverAsync -- Block until async exception. + race_ (cleanNetworkMutableState networkState) do + withServerNode + snocket + makeLocalBearer + mempty -- LocalSocket does not need to be configured + nullNetworkServerTracers + networkState + (AcceptedConnectionsLimit maxBound maxBound 0) + address + (codecHandshake forwardingVersionCodec) + timeLimits + (cborTermVersionDataCodec forwardingCodecCBORTerm) + (HandshakeCallbacks acceptableVersion queryVersion) + (simpleSingletonVersions + ForwardingV_1 + (ForwardingVersionData $ NetworkMagic netMagic) + (SomeResponderApplication app) + ) + nullErrorPolicies + $ \_ serverAsync -> wait serverAsync -- Block until async exception. runEKGAcceptor :: TracerEnv @@ -131,16 +140,19 @@ runEKGAcceptor tracerEnv ekgConfig errorHandler = runTraceObjectsAcceptor :: TracerEnv + -> TracerEnvRTView -> TF.AcceptorConfiguration TraceObject -> (ConnectionId LocalAddress -> IO ()) -> RunMiniProtocol 'ResponderMode initiatorCtx (ResponderContext LocalAddress) LBS.ByteString IO Void () -runTraceObjectsAcceptor tracerEnv tfConfig errorHandler = +runTraceObjectsAcceptor tracerEnv + tracerEnvRTView + tfConfig errorHandler = acceptTraceObjectsResp tfConfig - (traceObjectsHandler tracerEnv . connIdToNodeId . rcConnectionId) + (traceObjectsHandler tracerEnv tracerEnvRTView . connIdToNodeId . rcConnectionId) (errorHandler . rcConnectionId) runDataPointsAcceptor diff --git a/cardano-tracer/src/Cardano/Tracer/Acceptors/Utils.hs b/cardano-tracer/src/Cardano/Tracer/Acceptors/Utils.hs index faf49bdf8b0..a28e89c6a9f 100644 --- a/cardano-tracer/src/Cardano/Tracer/Acceptors/Utils.hs +++ b/cardano-tracer/src/Cardano/Tracer/Acceptors/Utils.hs @@ -1,17 +1,21 @@ {-# LANGUAGE NamedFieldPuns #-} +#if RTVIEW {-# LANGUAGE OverloadedStrings #-} +#endif module Cardano.Tracer.Acceptors.Utils - ( notifyAboutNodeDisconnected - , prepareDataPointRequestor + ( prepareDataPointRequestor , prepareMetricsStores , removeDisconnectedNode + , notifyAboutNodeDisconnected ) where +#if RTVIEW import Cardano.Logging (SeverityS (..)) +import Cardano.Tracer.Handlers.Notifications.Types +import Cardano.Tracer.Handlers.Notifications.Utils +#endif import Cardano.Tracer.Environment -import Cardano.Tracer.Handlers.RTView.Notifications.Types -import Cardano.Tracer.Handlers.RTView.Notifications.Utils import Cardano.Tracer.Types import Cardano.Tracer.Utils import Ouroboros.Network.Snocket (LocalAddress) @@ -22,7 +26,9 @@ import Control.Concurrent.STM.TVar (TVar, modifyTVar', newTVarIO) import qualified Data.Bimap as BM import qualified Data.Map.Strict as M import qualified Data.Set as S +#if RTVIEW import Data.Time.Clock.System (getSystemTime, systemToUTCTime) +#endif import qualified System.Metrics as EKG import System.Metrics.Store.Acceptor (MetricsLocalStore, emptyMetricsLocalStore) @@ -76,12 +82,16 @@ removeDisconnectedNode tracerEnv connId = nodeId = connIdToNodeId connId notifyAboutNodeDisconnected - :: TracerEnv + :: TracerEnvRTView -> ConnectionId LocalAddress -> IO () -notifyAboutNodeDisconnected TracerEnv{teEventsQueues} connId = do +#if RTVIEW +notifyAboutNodeDisconnected TracerEnvRTView{teEventsQueues} connId = do now <- systemToUTCTime <$> getSystemTime addNewEvent teEventsQueues EventNodeDisconnected $ Event nodeId now Warning msg where nodeId = connIdToNodeId connId msg = "Node is disconnected" +#else +notifyAboutNodeDisconnected _ _ = pure () +#endif diff --git a/cardano-tracer/src/Cardano/Tracer/Configuration.hs b/cardano-tracer/src/Cardano/Tracer/Configuration.hs index 73f56f9ae3c..5dc607b1a1b 100644 --- a/cardano-tracer/src/Cardano/Tracer/Configuration.hs +++ b/cardano-tracer/src/Cardano/Tracer/Configuration.hs @@ -149,7 +149,13 @@ readTracerConfig pathToConfig = } checkMeaninglessValues :: TracerConfig -> Either String () -checkMeaninglessValues TracerConfig{network, hasEKG, hasPrometheus, hasRTView, logging} = +checkMeaninglessValues TracerConfig + { network + , hasEKG + , hasPrometheus + , logging + , hasRTView + } = if null problems then Right () else Left $ intercalate ", " problems diff --git a/cardano-tracer/src/Cardano/Tracer/Environment.hs b/cardano-tracer/src/Cardano/Tracer/Environment.hs index 682a1ffeb32..0ced2f87650 100644 --- a/cardano-tracer/src/Cardano/Tracer/Environment.hs +++ b/cardano-tracer/src/Cardano/Tracer/Environment.hs @@ -1,13 +1,18 @@ +{-# LANGUAGE CPP #-} + module Cardano.Tracer.Environment ( TracerEnv (..) + , TracerEnvRTView (..) ) where import Cardano.Logging.Types import Cardano.Tracer.Configuration -import Cardano.Tracer.Handlers.RTView.Notifications.Types +#if RTVIEW +import Cardano.Tracer.Handlers.Notifications.Types import Cardano.Tracer.Handlers.RTView.State.Historical -import Cardano.Tracer.Handlers.RTView.State.TraceObjects import Cardano.Tracer.Handlers.RTView.UI.Types +import Cardano.Tracer.Handlers.State.TraceObjects +#endif import Cardano.Tracer.MetaTrace import Cardano.Tracer.Types @@ -19,18 +24,26 @@ data TracerEnv = TracerEnv , teConnectedNodes :: !ConnectedNodes , teConnectedNodesNames :: !ConnectedNodesNames , teAcceptedMetrics :: !AcceptedMetrics - , teSavedTO :: !SavedTraceObjects - , teBlockchainHistory :: !BlockchainHistory - , teResourcesHistory :: !ResourcesHistory - , teTxHistory :: !TransactionsHistory , teCurrentLogLock :: !Lock , teCurrentDPLock :: !Lock - , teEventsQueues :: !EventsQueues , teDPRequestors :: !DataPointRequestors , teProtocolsBrake :: !ProtocolsBrake - , teRTViewPageOpened :: !WebPageStatus - , teRTViewStateDir :: !(Maybe FilePath) , teTracer :: !(Trace IO TracerTrace) , teReforwardTraceObjects :: !([TraceObject] -> IO ()) , teRegistry :: !HandleRegistry + , teStateDir :: !(Maybe FilePath) + } + +#if RTVIEW +-- | Environment for all functions. +data TracerEnvRTView = TracerEnvRTView + { teSavedTO :: !SavedTraceObjects + , teBlockchainHistory :: !BlockchainHistory + , teResourcesHistory :: !ResourcesHistory + , teTxHistory :: !TransactionsHistory + , teEventsQueues :: !EventsQueues + , teRTViewPageOpened :: !WebPageStatus } +#else +data TracerEnvRTView = TracerEnvRTView +#endif diff --git a/cardano-tracer/src/Cardano/Tracer/Handlers/Logs/TraceObjects.hs b/cardano-tracer/src/Cardano/Tracer/Handlers/Logs/TraceObjects.hs index 3bc03f5cbd8..b201959399e 100644 --- a/cardano-tracer/src/Cardano/Tracer/Handlers/Logs/TraceObjects.hs +++ b/cardano-tracer/src/Cardano/Tracer/Handlers/Logs/TraceObjects.hs @@ -1,4 +1,7 @@ +{-# OPTIONS_GHC -fno-warn-unused-local-binds #-} + {-# LANGUAGE NamedFieldPuns #-} +{-# LANGUAGE CPP #-} module Cardano.Tracer.Handlers.Logs.TraceObjects ( traceObjectsHandler @@ -10,12 +13,16 @@ import Cardano.Tracer.Configuration import Cardano.Tracer.Environment import Cardano.Tracer.Handlers.Logs.File import Cardano.Tracer.Handlers.Logs.Journal +#if RTVIEW import Cardano.Tracer.Handlers.RTView.Run +#endif import Cardano.Tracer.Types import Cardano.Tracer.Utils import Control.Concurrent.Async (forConcurrently_) +#if RTVIEW import Control.Monad.Extra (whenJust) +#endif import qualified Data.Map as Map import System.IO (Handle, hClose) @@ -23,13 +30,13 @@ import System.IO (Handle, hClose) -- from 'trace-forward' library. traceObjectsHandler :: TracerEnv -- ^ Tracer environment. + -> TracerEnvRTView -- ^ Tracer environment, for RTView. -> NodeId -- ^ An id of the node 'TraceObject's were received from. -> [TraceObject] -- ^ The list of received 'TraceObject's (may be empty). -> IO () -traceObjectsHandler _ _ [] = return () -traceObjectsHandler tracerEnv nodeId traceObjects = do +traceObjectsHandler _ _ _ [] = return () +traceObjectsHandler tracerEnv _tracerEnvRTView nodeId traceObjects = do nodeName <- askNodeName tracerEnv nodeId - forConcurrently_ logging \loggingParams@LoggingParams{logMode} -> do showProblemIfAny verbosity do case logMode of @@ -38,21 +45,24 @@ traceObjectsHandler tracerEnv nodeId traceObjects = do loggingParams nodeName teCurrentLogLock traceObjects JournalMode -> writeTraceObjectsToJournal nodeName traceObjects - whenJust hasRTView \_ -> - saveTraceObjects teSavedTO nodeId traceObjects - teReforwardTraceObjects traceObjects - - where +#if RTVIEW + whenJust hasRTView \_ -> let + TracerEnvRTView { teSavedTO } = _tracerEnvRTView + in saveTraceObjects teSavedTO nodeId traceObjects +#endif + teReforwardTraceObjects traceObjects where TracerEnv - { teConfig = TracerConfig{logging, verbosity, hasRTView} + { teConfig = TracerConfig{ logging, verbosity, hasRTView } , teCurrentLogLock - , teSavedTO , teReforwardTraceObjects , teRegistry } = tracerEnv deregisterNodeId :: TracerEnv -> NodeId -> IO () -deregisterNodeId tracerEnv@TracerEnv{ teConfig = TracerConfig { logging }, teRegistry } nodeId = do +deregisterNodeId tracerEnv@TracerEnv + { teConfig = TracerConfig { logging } + , teRegistry + } nodeId = do nodeName <- askNodeName tracerEnv nodeId forConcurrently_ logging \loggingParams@LoggingParams{logMode} -> do diff --git a/cardano-tracer/src/Cardano/Tracer/Handlers/Metrics/Monitoring.hs b/cardano-tracer/src/Cardano/Tracer/Handlers/Metrics/Monitoring.hs index 0293989fee5..5b5074adb74 100644 --- a/cardano-tracer/src/Cardano/Tracer/Handlers/Metrics/Monitoring.hs +++ b/cardano-tracer/src/Cardano/Tracer/Handlers/Metrics/Monitoring.hs @@ -9,24 +9,49 @@ module Cardano.Tracer.Handlers.Metrics.Monitoring import Cardano.Tracer.Configuration import Cardano.Tracer.Environment -import Cardano.Tracer.Handlers.RTView.SSL.Certs +#if RTVIEW +import Cardano.Tracer.Handlers.SSL.Certs +#endif +import Cardano.Tracer.MetaTrace import Cardano.Tracer.Types import Control.Concurrent (ThreadId) import Control.Concurrent.STM (atomically) import Control.Concurrent.STM.TMVar (TMVar, newEmptyTMVarIO, putTMVar, tryReadTMVar) import Control.Concurrent.STM.TVar (readTVarIO) +#if RTVIEW import Control.Monad (forM, void) +#endif import Control.Monad.Extra (whenJust) +import Control.Monad.IO.Class (liftIO) +#if !RTVIEW +import Data.Foldable +import Data.Function ((&)) +#endif import qualified Data.Map.Strict as M import qualified Data.Set as S +#if !RTVIEW +import Data.String +#endif import qualified Data.Text as T import Data.Text.Encoding (encodeUtf8) import System.Remote.Monitoring (forkServerWith, serverThreadId) import System.Time.Extra (sleep) +#if !RTVIEW +import System.IO.Unsafe (unsafePerformIO) +import Text.Blaze.Html5 hiding (title) +import Text.Blaze.Html5.Attributes +#endif +#if RTVIEW import qualified Graphics.UI.Threepenny as UI -import Graphics.UI.Threepenny.Core (Element, UI, liftIO, set, (#), (#+)) +import Graphics.UI.Threepenny.Core (Element, UI, set, (#), (#+)) +#else +import Snap.Blaze (blaze) +import Snap.Core (Snap, route) +import Snap.Http.Server (Config, ConfigLog (..), defaultConfig, setAccessLog, setBind, + setErrorLog, setPort, simpleHttpServe) +#endif -- | 'ekg' package allows to run only one EKG server, to display only one web page -- for particular EKG.Store. Since 'cardano-tracer' can be connected to any number @@ -42,11 +67,16 @@ runMonitoringServer :: TracerEnv -> (Endpoint, Endpoint) -- ^ (web page with list of connected nodes, EKG web page). -> IO () -runMonitoringServer tracerEnv (Endpoint listHost listPort, monitorEP) = do +#if RTVIEW +runMonitoringServer tracerEnv (endpoint@(Endpoint listHost listPort), monitorEP) = do -- Pause to prevent collision between "Listening"-notifications from servers. sleep 0.2 (certFile, keyFile) <- placeDefaultSSLFiles tracerEnv - UI.startGUI (config certFile keyFile) $ \window -> do + traceWith (teTracer tracerEnv) TracerStartedMonitoring + { ttMonitoringEndpoint = endpoint + , ttMonitoringType = "list" + } + UI.startGUI (config certFile keyFile) \window -> do void $ return window # set UI.title "EKG Monitoring Nodes" void $ mkPageBody window tracerEnv monitorEP where @@ -62,10 +92,67 @@ runMonitoringServer tracerEnv (Endpoint listHost listPort, monitorEP) = do , UI.jsSSLChainCert = False } } +#else +runMonitoringServer tracerEnv (endpoint@(Endpoint listHost listPort), monitorEP) = do + -- Pause to prevent collision between "Listening"-notifications from servers. + sleep 0.2 + traceWith (teTracer tracerEnv) TracerStartedMonitoring + { ttMonitoringEndpoint = endpoint + , ttMonitoringType = "list" + } + simpleHttpServe config do + route + [ ("/", renderEkg) + ] + where + TracerEnv{teConnectedNodes} = tracerEnv --- | We have to keep an id of the node as well as thread id of currently launched EKG server. -type CurrentEKGServer = TMVar (NodeId, ThreadId) + config :: Config Snap () + config = defaultConfig + & setErrorLog ConfigNoLog + & setAccessLog ConfigNoLog + & setBind (encodeUtf8 (T.pack listHost)) + & setPort (fromIntegral listPort) + + renderEkg :: Snap () + renderEkg = do + nodes <- liftIO $ S.toList <$> readTVarIO teConnectedNodes + -- HACK + case nodes of + [] -> + pure () + nodeId:_nodes -> liftIO do + restartEKGServer tracerEnv nodeId monitorEP currentServerHack + blaze do + docTypeHtml do + ekgHtml monitorEP nodes +{-# NOINLINE currentServerHack #-} +-- | There is supposed to be one EKG server per port. The desired EKG +-- server for the connected node gets restarted always on the same +-- port. We limit functionality to only run one EKG server, this will +-- be resolved in a future PR. +currentServerHack :: CurrentEKGServer +currentServerHack = unsafePerformIO newEmptyTMVarIO + +ekgHtml + :: Endpoint + -> [NodeId] + -> Html +ekgHtml (Endpoint monitorHost monitorPort) = \case + [] -> + toHtml @T.Text "ekgHtml: There are no connected nodes yet" + connectedNodes -> do + for_ connectedNodes \(NodeId anId) -> + li do + a ! href (fromString ("http://" <> monitorHost <> ":" <> show monitorPort)) + ! target "_blank" + ! title "Open EKG monitor page for this node" + $ toHtml anId +#endif + +type CurrentEKGServer = TMVar (NodeId, ThreadId) +#if RTVIEW -- | The first web page contains only the list of hrefs -- corresponding to currently connected nodes. mkPageBody @@ -81,7 +168,7 @@ mkPageBody window tracerEnv mEP@(Endpoint monitorHost monitorPort) = do else do currentServer :: CurrentEKGServer <- liftIO newEmptyTMVarIO nodesLinks <- - forM nodes $ \nodeId@(NodeId anId) -> do + forM nodes \nodeId@(NodeId anId) -> do nodeLink <- UI.li #+ [ UI.anchor # set UI.href ("http://" <> monitorHost <> ":" <> show monitorPort) @@ -89,13 +176,16 @@ mkPageBody window tracerEnv mEP@(Endpoint monitorHost monitorPort) = do # set UI.title__ "Open EKG monitor page for this node" # set UI.text (T.unpack anId) ] - void $ UI.on UI.click nodeLink $ const $ - restartEKGServer tracerEnv nodeId mEP currentServer + void $ UI.on UI.click nodeLink $ const do + liftIO do + restartEKGServer + tracerEnv nodeId mEP currentServer return $ UI.element nodeLink UI.ul #+ nodesLinks UI.getBody window #+ [ UI.element nodesHrefs ] where TracerEnv{teConnectedNodes} = tracerEnv +#endif -- | After clicking on the node's href, the user will be redirected to the monitoring page -- which is rendered by 'ekg' package. But before, we have to check if EKG server is @@ -105,17 +195,17 @@ restartEKGServer -> NodeId -> Endpoint -> CurrentEKGServer - -> UI () -restartEKGServer TracerEnv{teAcceptedMetrics} newNodeId - (Endpoint monitorHost monitorPort) currentServer = liftIO $ do + -> IO () +restartEKGServer TracerEnv{teAcceptedMetrics, teTracer} newNodeId + endpoint@(Endpoint monitorHost monitorPort) currentServer = do metrics <- readTVarIO teAcceptedMetrics - whenJust (metrics M.!? newNodeId) $ \(storeForSelectedNode, _) -> + whenJust (metrics M.!? newNodeId) \(storeForSelectedNode, _) -> atomically (tryReadTMVar currentServer) >>= \case Just (_curNodeId, _sThread) -> -- TODO: Currently we cannot restart EKG server, -- please see https://github.com/tibbe/ekg/issues/87 return () - -- unless (newNodeId == curNodeId) $ do + -- unless (newNodeId == curNodeId) do -- killThread sThread -- runEKGAndSave storeForSelectedNode Nothing -> @@ -123,6 +213,10 @@ restartEKGServer TracerEnv{teAcceptedMetrics} newNodeId runEKGAndSave storeForSelectedNode where runEKGAndSave store = do + traceWith teTracer TracerStartedMonitoring + { ttMonitoringEndpoint = endpoint + , ttMonitoringType = "monitor" + } ekgServer <- forkServerWith store (encodeUtf8 . T.pack $ monitorHost) (fromIntegral monitorPort) diff --git a/cardano-tracer/src/Cardano/Tracer/Handlers/Metrics/Prometheus.hs b/cardano-tracer/src/Cardano/Tracer/Handlers/Metrics/Prometheus.hs index 2f006f80919..4290e17a8da 100644 --- a/cardano-tracer/src/Cardano/Tracer/Handlers/Metrics/Prometheus.hs +++ b/cardano-tracer/src/Cardano/Tracer/Handlers/Metrics/Prometheus.hs @@ -9,6 +9,7 @@ module Cardano.Tracer.Handlers.Metrics.Prometheus import Cardano.Tracer.Configuration import Cardano.Tracer.Environment +import Cardano.Tracer.MetaTrace import Cardano.Tracer.Types import Cardano.Tracer.Utils @@ -18,6 +19,7 @@ import Control.Concurrent.STM.TVar (readTVarIO) import Control.Monad (forever) import Control.Monad.IO.Class (liftIO) import qualified Data.Bimap as BM +import Data.Function ((&)) import Data.Functor ((<&>)) import qualified Data.HashMap.Strict as HM import qualified Data.Map.Strict as M @@ -58,27 +60,30 @@ runPrometheusServer :: TracerEnv -> Endpoint -> IO () -runPrometheusServer tracerEnv (Endpoint host port) = forever $ do +runPrometheusServer tracerEnv endpoint@(Endpoint host port) = forever do -- Pause to prevent collision between "Listening"-notifications from servers. sleep 0.1 -- If everything is okay, the function 'simpleHttpServe' never returns. -- But if there is some problem, it never throws an exception, but just stops. -- So if it stopped - it will be re-started. - simpleHttpServe config $ - route [ ("/", renderListOfConnectedNodes) - , ("/:nodename", renderMetricsFromNode) - ] + traceWith (teTracer tracerEnv) TracerStartedPrometheus + { ttPrometheusEndpoint = endpoint + } + simpleHttpServe config do + route + [ ("/", renderListOfConnectedNodes) + , ("/:nodename", renderMetricsFromNode) + ] sleep 1.0 where TracerEnv{teConnectedNodesNames, teAcceptedMetrics} = tracerEnv config :: Config Snap () - config = - setPort (fromIntegral port) - . setBind (encodeUtf8 . T.pack $ host) - . setAccessLog ConfigNoLog - . setErrorLog ConfigNoLog - $ defaultConfig + config = defaultConfig + & setErrorLog ConfigNoLog + & setAccessLog ConfigNoLog + & setBind (encodeUtf8 (T.pack host)) + & setPort (fromIntegral port) renderListOfConnectedNodes :: Snap () renderListOfConnectedNodes = do diff --git a/cardano-tracer/src/Cardano/Tracer/Handlers/Metrics/Servers.hs b/cardano-tracer/src/Cardano/Tracer/Handlers/Metrics/Servers.hs index d70d66ad9ee..0a50e856fd3 100644 --- a/cardano-tracer/src/Cardano/Tracer/Handlers/Metrics/Servers.hs +++ b/cardano-tracer/src/Cardano/Tracer/Handlers/Metrics/Servers.hs @@ -1,4 +1,5 @@ {-# LANGUAGE NamedFieldPuns #-} +{-# LANGUAGE CPP #-} module Cardano.Tracer.Handlers.Metrics.Servers ( runMetricsServers @@ -8,25 +9,28 @@ import Cardano.Tracer.Configuration import Cardano.Tracer.Environment import Cardano.Tracer.Handlers.Metrics.Monitoring import Cardano.Tracer.Handlers.Metrics.Prometheus -import Cardano.Tracer.MetaTrace import Control.Concurrent.Async.Extra (sequenceConcurrently) import Control.Monad (void) +import Data.Maybe (catMaybes) -- | Runs metrics servers if needed: -- -- 1. Prometheus exporter. -- 2. EKG monitoring web-page. -- -runMetricsServers :: TracerEnv -> IO () -runMetricsServers tracerEnv@TracerEnv{teConfig, teTracer} = - case (hasEKG teConfig, hasPrometheus teConfig) of - (Nothing, Nothing) -> return () - (Nothing, Just prom) -> do - traceWith teTracer TracerStartedPrometheus - runPrometheusServer tracerEnv prom - (Just ekg, Nothing) -> runMonitoringServer tracerEnv ekg - (Just ekg, Just prom) -> void . sequenceConcurrently $ - [ runPrometheusServer tracerEnv prom - , runMonitoringServer tracerEnv ekg - ] +runMetricsServers + :: TracerEnv + -> IO () +runMetricsServers tracerEnv = void do sequenceConcurrently servers + + where + servers :: [IO ()] + servers = catMaybes + [ runPrometheusServer tracerEnv <$> hasPrometheus + , runMonitoringServer tracerEnv <$> hasEKG + ] + + TracerEnv + { teConfig = TracerConfig { hasPrometheus, hasEKG } + } = tracerEnv diff --git a/cardano-tracer/src/Cardano/Tracer/Handlers/RTView/Notifications/Check.hs b/cardano-tracer/src/Cardano/Tracer/Handlers/Notifications/Check.hs similarity index 65% rename from cardano-tracer/src/Cardano/Tracer/Handlers/RTView/Notifications/Check.hs rename to cardano-tracer/src/Cardano/Tracer/Handlers/Notifications/Check.hs index b74d9a8b9fb..dfaddd1ecf2 100644 --- a/cardano-tracer/src/Cardano/Tracer/Handlers/RTView/Notifications/Check.hs +++ b/cardano-tracer/src/Cardano/Tracer/Handlers/Notifications/Check.hs @@ -1,14 +1,11 @@ -module Cardano.Tracer.Handlers.RTView.Notifications.Check +module Cardano.Tracer.Handlers.Notifications.Check ( checkCommonErrors ) where ---import Data.Text (Text) ---import qualified Data.Text as T - import Cardano.Logging (SeverityS (..)) -import Cardano.Tracer.Handlers.RTView.Notifications.Types -import Cardano.Tracer.Handlers.RTView.Notifications.Utils -import Cardano.Tracer.Handlers.RTView.State.TraceObjects +import Cardano.Tracer.Handlers.Notifications.Types +import Cardano.Tracer.Handlers.Notifications.Utils +import Cardano.Tracer.Handlers.State.TraceObjects import Cardano.Tracer.Types checkCommonErrors diff --git a/cardano-tracer/src/Cardano/Tracer/Handlers/RTView/Notifications/Email.hs b/cardano-tracer/src/Cardano/Tracer/Handlers/Notifications/Email.hs similarity index 95% rename from cardano-tracer/src/Cardano/Tracer/Handlers/RTView/Notifications/Email.hs rename to cardano-tracer/src/Cardano/Tracer/Handlers/Notifications/Email.hs index 13fdafa0acd..8487bb06fcb 100644 --- a/cardano-tracer/src/Cardano/Tracer/Handlers/RTView/Notifications/Email.hs +++ b/cardano-tracer/src/Cardano/Tracer/Handlers/Notifications/Email.hs @@ -2,14 +2,14 @@ {-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE OverloadedStrings #-} -module Cardano.Tracer.Handlers.RTView.Notifications.Email +module Cardano.Tracer.Handlers.Notifications.Email ( StatusMessage , createAndSendEmail , createAndSendTestEmail , statusIsOK ) where -import Cardano.Tracer.Handlers.RTView.Notifications.Types +import Cardano.Tracer.Handlers.Notifications.Types import Control.Concurrent.Async (race) import Control.Exception.Extra (try_) diff --git a/cardano-tracer/src/Cardano/Tracer/Handlers/RTView/Notifications/Send.hs b/cardano-tracer/src/Cardano/Tracer/Handlers/Notifications/Send.hs similarity index 92% rename from cardano-tracer/src/Cardano/Tracer/Handlers/RTView/Notifications/Send.hs rename to cardano-tracer/src/Cardano/Tracer/Handlers/Notifications/Send.hs index e3907256c83..391489ae37d 100644 --- a/cardano-tracer/src/Cardano/Tracer/Handlers/RTView/Notifications/Send.hs +++ b/cardano-tracer/src/Cardano/Tracer/Handlers/Notifications/Send.hs @@ -1,12 +1,12 @@ {-# LANGUAGE OverloadedStrings #-} -module Cardano.Tracer.Handlers.RTView.Notifications.Send +module Cardano.Tracer.Handlers.Notifications.Send ( makeAndSendNotification ) where import Cardano.Logging (showT) -import Cardano.Tracer.Handlers.RTView.Notifications.Email -import Cardano.Tracer.Handlers.RTView.Notifications.Types +import Cardano.Tracer.Handlers.Notifications.Email +import Cardano.Tracer.Handlers.Notifications.Types import Cardano.Tracer.Types import Cardano.Tracer.Utils diff --git a/cardano-tracer/src/Cardano/Tracer/Handlers/RTView/Notifications/Settings.hs b/cardano-tracer/src/Cardano/Tracer/Handlers/Notifications/Settings.hs similarity index 88% rename from cardano-tracer/src/Cardano/Tracer/Handlers/RTView/Notifications/Settings.hs rename to cardano-tracer/src/Cardano/Tracer/Handlers/Notifications/Settings.hs index ddca1380ef8..b98a3b7343f 100644 --- a/cardano-tracer/src/Cardano/Tracer/Handlers/RTView/Notifications/Settings.hs +++ b/cardano-tracer/src/Cardano/Tracer/Handlers/Notifications/Settings.hs @@ -3,7 +3,7 @@ {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE ScopedTypeVariables #-} -module Cardano.Tracer.Handlers.RTView.Notifications.Settings +module Cardano.Tracer.Handlers.Notifications.Settings ( incompleteEmailSettings , readSavedEmailSettings , readSavedEventsSettings @@ -12,8 +12,8 @@ module Cardano.Tracer.Handlers.RTView.Notifications.Settings ) where import Cardano.Tracer.Environment -import Cardano.Tracer.Handlers.RTView.Notifications.Types -import Cardano.Tracer.Handlers.RTView.System +import Cardano.Tracer.Handlers.Notifications.Types +import Cardano.Tracer.Handlers.System import Control.Exception.Extra (ignore, try_) import Data.Aeson (decodeStrict', encode, encodeFile) @@ -21,10 +21,6 @@ import qualified Data.ByteString as BS import qualified Data.ByteString.Lazy as LBS import qualified Data.Text as T -import Crypto.Cipher.AES () -import Crypto.Cipher.Types () -import Crypto.Error () - readSavedEmailSettings :: Maybe FilePath -> IO EmailSettings readSavedEmailSettings rtvSD = do (pathToEmailSettings, _) <- getPathsToNotificationsSettings rtvSD @@ -93,8 +89,8 @@ readSavedEventsSettings rtvSD = do defaultState = (False, 1800) saveEmailSettingsOnDisk :: TracerEnv -> EmailSettings -> IO () -saveEmailSettingsOnDisk TracerEnv{teRTViewStateDir} settings = ignore $ do - (pathToEmailSettings, _) <- getPathsToNotificationsSettings teRTViewStateDir +saveEmailSettingsOnDisk TracerEnv{teStateDir} settings = ignore do + (pathToEmailSettings, _) <- getPathsToNotificationsSettings teStateDir LBS.writeFile pathToEmailSettings $ encode settings -- Encrypt JSON-content to avoid saving user's private data in "plain mode". -- case encryptJSON . LBS.toStrict . encode $ settings of @@ -102,6 +98,6 @@ saveEmailSettingsOnDisk TracerEnv{teRTViewStateDir} settings = ignore $ do -- Left _ -> return () saveEventsSettingsOnDisk :: TracerEnv -> EventsSettings -> IO () -saveEventsSettingsOnDisk TracerEnv{teRTViewStateDir} settings = ignore $ do - (_, pathToEventsSettings) <- getPathsToNotificationsSettings teRTViewStateDir +saveEventsSettingsOnDisk TracerEnv{teStateDir} settings = ignore do + (_, pathToEventsSettings) <- getPathsToNotificationsSettings teStateDir encodeFile pathToEventsSettings settings diff --git a/cardano-tracer/src/Cardano/Tracer/Handlers/RTView/Notifications/Timer.hs b/cardano-tracer/src/Cardano/Tracer/Handlers/Notifications/Timer.hs similarity index 96% rename from cardano-tracer/src/Cardano/Tracer/Handlers/RTView/Notifications/Timer.hs rename to cardano-tracer/src/Cardano/Tracer/Handlers/Notifications/Timer.hs index e2f046c0fba..e8ec1bf19f2 100644 --- a/cardano-tracer/src/Cardano/Tracer/Handlers/RTView/Notifications/Timer.hs +++ b/cardano-tracer/src/Cardano/Tracer/Handlers/Notifications/Timer.hs @@ -1,6 +1,6 @@ {-# LANGUAGE NamedFieldPuns #-} -module Cardano.Tracer.Handlers.RTView.Notifications.Timer +module Cardano.Tracer.Handlers.Notifications.Timer ( PeriodInSec , Timer , mkTimer diff --git a/cardano-tracer/src/Cardano/Tracer/Handlers/RTView/Notifications/Types.hs b/cardano-tracer/src/Cardano/Tracer/Handlers/Notifications/Types.hs similarity index 94% rename from cardano-tracer/src/Cardano/Tracer/Handlers/RTView/Notifications/Types.hs rename to cardano-tracer/src/Cardano/Tracer/Handlers/Notifications/Types.hs index b9c8eefeb7c..d435e64a0b4 100644 --- a/cardano-tracer/src/Cardano/Tracer/Handlers/RTView/Notifications/Types.hs +++ b/cardano-tracer/src/Cardano/Tracer/Handlers/Notifications/Types.hs @@ -1,7 +1,7 @@ {-# LANGUAGE DeriveAnyClass #-} {-# LANGUAGE DeriveGeneric #-} -module Cardano.Tracer.Handlers.RTView.Notifications.Types +module Cardano.Tracer.Handlers.Notifications.Types ( EmailSSL (..) , EmailSettings (..) , EventsSettings (..) @@ -12,7 +12,7 @@ module Cardano.Tracer.Handlers.RTView.Notifications.Types ) where import Cardano.Logging (SeverityS (..)) -import Cardano.Tracer.Handlers.RTView.Notifications.Timer +import Cardano.Tracer.Handlers.Notifications.Timer import Cardano.Tracer.Types import Control.Concurrent.STM.TBQueue (TBQueue) diff --git a/cardano-tracer/src/Cardano/Tracer/Handlers/RTView/Notifications/Utils.hs b/cardano-tracer/src/Cardano/Tracer/Handlers/Notifications/Utils.hs similarity index 87% rename from cardano-tracer/src/Cardano/Tracer/Handlers/RTView/Notifications/Utils.hs rename to cardano-tracer/src/Cardano/Tracer/Handlers/Notifications/Utils.hs index 01227ac0c34..a471c1f4c87 100644 --- a/cardano-tracer/src/Cardano/Tracer/Handlers/RTView/Notifications/Utils.hs +++ b/cardano-tracer/src/Cardano/Tracer/Handlers/Notifications/Utils.hs @@ -1,5 +1,5 @@ -module Cardano.Tracer.Handlers.RTView.Notifications.Utils +module Cardano.Tracer.Handlers.Notifications.Utils ( addNewEvent , getNewEvents , initEventsQueues @@ -7,11 +7,11 @@ module Cardano.Tracer.Handlers.RTView.Notifications.Utils , updateNotificationsPeriods ) where -import Cardano.Tracer.Handlers.RTView.Notifications.Send -import Cardano.Tracer.Handlers.RTView.Notifications.Settings -import Cardano.Tracer.Handlers.RTView.Notifications.Timer -import Cardano.Tracer.Handlers.RTView.Notifications.Types -import Cardano.Tracer.Handlers.RTView.Update.Utils +import Cardano.Tracer.Handlers.Notifications.Send +import Cardano.Tracer.Handlers.Notifications.Settings +import Cardano.Tracer.Handlers.Notifications.Timer +import Cardano.Tracer.Handlers.Notifications.Types +import Cardano.Tracer.Handlers.Utils import Cardano.Tracer.Types import Control.Concurrent.Extra (Lock) diff --git a/cardano-tracer/src/Cardano/Tracer/Handlers/RTView/Run.hs b/cardano-tracer/src/Cardano/Tracer/Handlers/RTView/Run.hs index 18b3f722805..cd2ce634db6 100644 --- a/cardano-tracer/src/Cardano/Tracer/Handlers/RTView/Run.hs +++ b/cardano-tracer/src/Cardano/Tracer/Handlers/RTView/Run.hs @@ -2,21 +2,21 @@ module Cardano.Tracer.Handlers.RTView.Run ( runRTView - , module Cardano.Tracer.Handlers.RTView.Notifications.Utils - , module Cardano.Tracer.Handlers.RTView.State.TraceObjects + , module Cardano.Tracer.Handlers.Notifications.Utils + , module Cardano.Tracer.Handlers.State.TraceObjects ) where import Cardano.Tracer.Configuration import Cardano.Tracer.Environment -import Cardano.Tracer.Handlers.RTView.Notifications.Utils -import Cardano.Tracer.Handlers.RTView.SSL.Certs +import Cardano.Tracer.Handlers.Notifications.Utils import Cardano.Tracer.Handlers.RTView.State.Displayed import Cardano.Tracer.Handlers.RTView.State.EraSettings import Cardano.Tracer.Handlers.RTView.State.Last -import Cardano.Tracer.Handlers.RTView.State.TraceObjects import Cardano.Tracer.Handlers.RTView.UI.HTML.Main import Cardano.Tracer.Handlers.RTView.Update.EraSettings import Cardano.Tracer.Handlers.RTView.Update.Historical +import Cardano.Tracer.Handlers.SSL.Certs +import Cardano.Tracer.Handlers.State.TraceObjects import Cardano.Tracer.MetaTrace import Control.Concurrent.Async.Extra (sequenceConcurrently) @@ -36,9 +36,9 @@ import qualified Graphics.UI.Threepenny as UI -- The web-page is built using 'threepenny-gui' library. Please note -- Gitub-version of this library is used, not Hackage-version! -runRTView :: TracerEnv -> IO () -runRTView tracerEnv@TracerEnv{teTracer} = - whenJust hasRTView $ \(Endpoint host port) -> do +runRTView :: TracerEnv -> TracerEnvRTView -> IO () +runRTView tracerEnv@TracerEnv{teTracer} tracerEnvRTView = + whenJust hasRTView \(Endpoint host port) -> do traceWith teTracer TracerStartedRTView -- Pause to prevent collision between "Listening"-notifications from servers. sleep 0.3 @@ -59,13 +59,14 @@ runRTView tracerEnv@TracerEnv{teTracer} = [ UI.startGUI (config host port certFile keyFile) $ mkMainPage tracerEnv + tracerEnvRTView displayedElements eraSettings reloadFlag logging network - , runHistoricalUpdater tracerEnv lastResources - , runHistoricalBackup tracerEnv + , runHistoricalUpdater tracerEnv tracerEnvRTView lastResources + , runHistoricalBackup tracerEnv tracerEnvRTView , runEraSettingsUpdater tracerEnv eraSettings ] where diff --git a/cardano-tracer/src/Cardano/Tracer/Handlers/RTView/State/Historical.hs b/cardano-tracer/src/Cardano/Tracer/Handlers/RTView/State/Historical.hs index d626c472469..a3e345cfd33 100644 --- a/cardano-tracer/src/Cardano/Tracer/Handlers/RTView/State/Historical.hs +++ b/cardano-tracer/src/Cardano/Tracer/Handlers/RTView/State/Historical.hs @@ -22,7 +22,7 @@ module Cardano.Tracer.Handlers.RTView.State.Historical , readValueD ) where -import Cardano.Tracer.Handlers.RTView.Update.Utils +import Cardano.Tracer.Handlers.Utils import Cardano.Tracer.Types (NodeId) import Control.Concurrent.STM (atomically) diff --git a/cardano-tracer/src/Cardano/Tracer/Handlers/RTView/UI/Charts.hs b/cardano-tracer/src/Cardano/Tracer/Handlers/RTView/UI/Charts.hs index 6212d828d6e..c426162a2b0 100644 --- a/cardano-tracer/src/Cardano/Tracer/Handlers/RTView/UI/Charts.hs +++ b/cardano-tracer/src/Cardano/Tracer/Handlers/RTView/UI/Charts.hs @@ -24,17 +24,18 @@ module Cardano.Tracer.Handlers.RTView.UI.Charts , restoreAllHistoryOnChart , restoreLastHistoryOnAllCharts , restoreLastHistoryOnCharts + , PointsAdder ) where import Cardano.Tracer.Environment import Cardano.Tracer.Handlers.RTView.State.Historical -import Cardano.Tracer.Handlers.RTView.System import Cardano.Tracer.Handlers.RTView.UI.CSS.Own import qualified Cardano.Tracer.Handlers.RTView.UI.JS.Charts as Chart import qualified Cardano.Tracer.Handlers.RTView.UI.JS.Utils as JS import Cardano.Tracer.Handlers.RTView.UI.Types import Cardano.Tracer.Handlers.RTView.UI.Utils import Cardano.Tracer.Handlers.RTView.Update.Historical +import Cardano.Tracer.Handlers.System import Cardano.Tracer.Types import Cardano.Tracer.Utils @@ -45,6 +46,7 @@ import Control.Exception.Extra (ignore, try_) import Control.Monad (forM, forM_, unless, when) import Control.Monad.Extra (whenJustM) import Data.Aeson (decodeFileStrict', encodeFile) +import Data.Kind import Data.List (find, isInfixOf) import Data.List.Extra (chunksOf) import qualified Data.Map.Strict as M @@ -130,6 +132,15 @@ addNodeDatasetsToCharts tracerEnv colors datasetIndices nodeId@(NodeId anId) = d defaultColor = Color "#cccc00" +type PointsAdder :: Type -> Type +type PointsAdder a = + TracerEnv + -> History + -> DatasetsIndices + -> DataName + -> ChartId + -> UI a + -- Each chart updates independently from others. Because of this, the user -- can specify "auto-update period" for each chart. Some of data (by its nature) -- shoudn't be updated too frequently. @@ -138,24 +149,11 @@ addNodeDatasetsToCharts tracerEnv colors datasetIndices nodeId@(NodeId anId) = d -- using one single FFI-call, for better performance. -- -- 'addAllPointsToChart' doesn not do average calculation, it pushes all the points as they are. -addPointsToChart, addAllPointsToChart - :: TracerEnv - -> History - -> DatasetsIndices - -> DataName - -> ChartId - -> UI () +addPointsToChart, addAllPointsToChart :: PointsAdder () addPointsToChart = doAddPointsToChart replacePointsByAvgPoints addAllPointsToChart = doAddPointsToChart id -doAddPointsToChart - :: ([HistoricalPoint] -> [HistoricalPoint]) - -> TracerEnv - -> History - -> DatasetsIndices - -> DataName - -> ChartId - -> UI () +doAddPointsToChart :: ([HistoricalPoint] -> [HistoricalPoint]) -> PointsAdder () doAddPointsToChart replaceByAvg tracerEnv hist datasetIndices dataName chartId = do connected <- liftIO $ S.toList <$> readTVarIO (teConnectedNodes tracerEnv) dataForPush <- @@ -254,9 +252,9 @@ restoreAllHistoryOnChart -> UI () restoreAllHistoryOnChart tracerEnv dataName chartId dsIxs = do pointsFromBackup <- liftIO $ getAllHistoryFromBackup tracerEnv dataName - forM_ pointsFromBackup $ \(nodeId, points) -> do + forM_ pointsFromBackup \(nodeId, points) -> do nodeName <- liftIO $ askNodeName tracerEnv nodeId - whenJustM (getDatasetIx dsIxs nodeName) $ \ix -> do + whenJustM (getDatasetIx dsIxs nodeName) \ix -> do Chart.clearPointsChartJS chartId [ix] Chart.addAllPointsChartJS chartId [(ix, replacePointsByAvgPoints points)] @@ -265,7 +263,8 @@ restoreLastHistoryOnAllCharts -> DatasetsIndices -> UI () restoreLastHistoryOnAllCharts tracerEnv = - restoreLastHistoryOnCharts' tracerEnv (getLastHistoryFromBackupsAll tracerEnv) + restoreLastHistoryOnCharts' tracerEnv + (getLastHistoryFromBackupsAll tracerEnv) restoreLastHistoryOnCharts :: TracerEnv @@ -273,7 +272,8 @@ restoreLastHistoryOnCharts -> S.Set NodeId -> UI () restoreLastHistoryOnCharts tracerEnv dsIxs nodeIds = - restoreLastHistoryOnCharts' tracerEnv (getLastHistoryFromBackups tracerEnv nodeIds) dsIxs + restoreLastHistoryOnCharts' tracerEnv + (getLastHistoryFromBackups tracerEnv nodeIds) dsIxs restoreLastHistoryOnCharts' :: TracerEnv diff --git a/cardano-tracer/src/Cardano/Tracer/Handlers/RTView/UI/HTML/About.hs b/cardano-tracer/src/Cardano/Tracer/Handlers/RTView/UI/HTML/About.hs index 06f0689e9b6..8707fad6b2b 100644 --- a/cardano-tracer/src/Cardano/Tracer/Handlers/RTView/UI/HTML/About.hs +++ b/cardano-tracer/src/Cardano/Tracer/Handlers/RTView/UI/HTML/About.hs @@ -6,11 +6,9 @@ module Cardano.Tracer.Handlers.RTView.UI.HTML.About ) where import Cardano.Git.Rev (gitRev) -import Cardano.Tracer.Handlers.RTView.System import Cardano.Tracer.Handlers.RTView.UI.Img.Icons import Cardano.Tracer.Handlers.RTView.UI.JS.Utils import Cardano.Tracer.Handlers.RTView.UI.Utils - import Data.List.Extra (lower) import qualified Data.Text as T import Data.Version (showVersion) @@ -21,6 +19,7 @@ import System.Info (os) import qualified Graphics.UI.Threepenny as UI import Graphics.UI.Threepenny.Core import Paths_cardano_tracer (version) +import Cardano.Tracer.Utils (getProcessId) mkAboutInfo :: UI Element mkAboutInfo = do @@ -31,11 +30,11 @@ mkAboutInfo = do copyPath <- UI.button #. "button is-info" #+ [image "rt-view-copy-icon-on-button" copySVG] - on UI.click copyPath . const $ + on_ UI.click copyPath do copyTextToClipboard pathToConfig closeIt <- UI.button #. "delete" - pid <- getProcessId + pid <- liftIO getProcessId info <- UI.div #. "modal" #+ [ UI.div #. "modal-background" #+ [] @@ -104,7 +103,7 @@ mkAboutInfo = do ] ] ] - on UI.click closeIt . const $ element info #. "modal" + on_ UI.click closeIt do element info #. "modal" return info where commit = T.unpack . T.take 7 $ $(gitRev) diff --git a/cardano-tracer/src/Cardano/Tracer/Handlers/RTView/UI/HTML/Body.hs b/cardano-tracer/src/Cardano/Tracer/Handlers/RTView/UI/HTML/Body.hs index 4b07d23a131..1fac5b69679 100644 --- a/cardano-tracer/src/Cardano/Tracer/Handlers/RTView/UI/HTML/Body.hs +++ b/cardano-tracer/src/Cardano/Tracer/Handlers/RTView/UI/HTML/Body.hs @@ -36,13 +36,14 @@ import Graphics.UI.Threepenny.JQuery (Easing (..), fadeIn, fadeOut) mkPageBody :: TracerEnv + -> TracerEnvRTView -> Network -> DatasetsIndices -> UI Element -mkPageBody tracerEnv networkConfig dsIxs = do - let ResHistory rHistory = teResourcesHistory tracerEnv - ChainHistory cHistory = teBlockchainHistory tracerEnv - TXHistory tHistory = teTxHistory tracerEnv +mkPageBody tracerEnv tracerEnvRTView networkConfig dsIxs = do + let ResHistory rHistory = teResourcesHistory tracerEnvRTView + ChainHistory cHistory = teBlockchainHistory tracerEnvRTView + TXHistory tHistory = teTxHistory tracerEnvRTView txsProcessedNumTimer <- mkChartTimer tracerEnv tHistory dsIxs TxsProcessedNumData TxsProcessedNumChart mempoolBytesTimer <- mkChartTimer tracerEnv tHistory dsIxs MempoolBytesData MempoolBytesChart @@ -119,13 +120,13 @@ mkPageBody tracerEnv networkConfig dsIxs = do # set dataTooltip "Click to hide Resources" # set dataState shownState - on UI.click showHideTxs . const $ + on_ UI.click showHideTxs do changeVisibilityForCharts showHideTxs "transactions-charts" "Transactions" - on UI.click showHideChain . const $ + on_ UI.click showHideChain do changeVisibilityForCharts showHideChain "chain-charts" "Blockchain" - on UI.click showHideLeadership . const $ + on_ UI.click showHideLeadership do changeVisibilityForCharts showHideLeadership "leadership-charts" "Leadership" - on UI.click showHideResources . const $ + on_ UI.click showHideResources do changeVisibilityForCharts showHideResources "resources-charts" "Resources" logsLiveView <- mkLogsLiveView tracerEnv @@ -133,7 +134,7 @@ mkPageBody tracerEnv networkConfig dsIxs = do #. "button is-info is-medium" # set text "Logs view" # hideIt - on UI.click logsLiveViewButton . const $ do + on_ UI.click logsLiveViewButton do fadeInModal logsLiveView void $ element logsLiveView # set dataState "opened" updateLogsLiveViewNodes tracerEnv @@ -147,7 +148,7 @@ mkPageBody tracerEnv networkConfig dsIxs = do [ UI.div ## "preloader" #. "pageloader is-active" #+ [ UI.span #. "title" # set text "Just a second..." ] - , topNavigation tracerEnv + , topNavigation tracerEnv tracerEnvRTView , mkNoNodesInfo networkConfig , UI.mkElement "section" #. "section" #+ [ UI.div ## "main-table-container" @@ -395,7 +396,7 @@ mkPageBody tracerEnv networkConfig dsIxs = do UI.start aboutToLeadTimer UI.start couldNotForgeTimer - on UI.disconnect window . const $ do + on_ UI.disconnect window do UI.stop txsProcessedNumTimer UI.stop mempoolBytesTimer UI.stop txsInMempoolTimer @@ -452,7 +453,7 @@ mkPageBody tracerEnv networkConfig dsIxs = do , UI.option # set value "3600" # set text "1 hour" ] - on UI.selectionChange selectTimeRange . const $ + on_ UI.selectionChange selectTimeRange do whenJustM (readMaybe <$> get value selectTimeRange) $ \(rangeInSec :: Int) -> do Chart.setTimeRange chartId rangeInSec when (rangeInSec == 0) $ do @@ -463,10 +464,10 @@ mkPageBody tracerEnv networkConfig dsIxs = do Chart.resetZoomChartJS chartId saveChartsSettings tracerEnv - on UI.selectionChange selectUpdatePeriod . const $ - whenJustM (readMaybe <$> get value selectUpdatePeriod) $ \(periodInSec :: Int) -> do + on_ UI.selectionChange selectUpdatePeriod do + whenJustM (readMaybe <$> get value selectUpdatePeriod) \(periodInSec :: Int) -> do whenM (get UI.running chartUpdateTimer) $ UI.stop chartUpdateTimer - unless (periodInSec == 0) $ do + unless (periodInSec == 0) do void $ return chartUpdateTimer # set UI.interval (periodInSec * 1_000) UI.start chartUpdateTimer saveChartsSettings tracerEnv @@ -490,13 +491,14 @@ mkPageBody tracerEnv networkConfig dsIxs = do , UI.canvas ## show chartId #. "rt-view-chart-area" #+ [] ] -topNavigation :: TracerEnv -> UI Element -topNavigation tracerEnv@TracerEnv{teEventsQueues} = do +topNavigation :: TracerEnv -> TracerEnvRTView -> UI Element +topNavigation tracerEnv TracerEnvRTView{teEventsQueues} = do info <- mkAboutInfo infoIcon <- image "has-tooltip-multiline has-tooltip-bottom rt-view-info-icon mr-1" rtViewInfoSVG ## "info-icon" # set dataTooltip "RTView info" - on UI.click infoIcon . const $ fadeInModal info + on_ UI.click infoIcon do + fadeInModal info notificationsEvents <- mkNotificationsEvents tracerEnv teEventsQueues notificationsSettings <- mkNotificationsSettings tracerEnv @@ -509,9 +511,9 @@ topNavigation tracerEnv@TracerEnv{teEventsQueues} = do [ image "rt-view-notify-menu-icon" settingsSVG , string "Settings" ] - on UI.click notificationsEventsItem . const $ + on_ UI.click notificationsEventsItem do fadeInModal notificationsEvents - on UI.click notificationsSettingsItem . const $ do + on_ UI.click notificationsSettingsItem do restoreEmailSettings tracerEnv fadeInModal notificationsSettings @@ -521,7 +523,8 @@ topNavigation tracerEnv@TracerEnv{teEventsQueues} = do themeIcon <- image "has-tooltip-multiline has-tooltip-bottom rt-view-theme-icon" rtViewThemeToLightSVG ## "theme-icon" # set dataTooltip "Switch to light theme" - on UI.click themeIcon . const $ switchTheme tracerEnv + on_ UI.click themeIcon do + switchTheme tracerEnv UI.div ## "top-bar" #. "navbar rt-view-top-bar" #+ [ element info @@ -596,35 +599,16 @@ changeVisibilityForCharts showHideIcon areaId areaName = do # set dataState shownState # set dataTooltip ("Click to hide " <> areaName) -mkChartTimer, mkChartTimer' - :: TracerEnv - -> History - -> DatasetsIndices - -> DataName - -> ChartId - -> UI UI.Timer +mkChartTimer, mkChartTimer' :: PointsAdder UI.Timer mkChartTimer = doMakeChartTimer addPointsToChart mkChartTimer' = doMakeChartTimer addAllPointsToChart -type PointsAdder = - TracerEnv - -> History - -> DatasetsIndices - -> DataName - -> ChartId - -> UI () - doMakeChartTimer - :: PointsAdder - -> TracerEnv - -> History - -> DatasetsIndices - -> DataName - -> ChartId - -> UI UI.Timer + :: PointsAdder () + -> PointsAdder UI.Timer doMakeChartTimer addPoints tracerEnv history datasetIndices dataName chartId = do uiUpdateTimer <- UI.timer # set UI.interval defaultUpdatePeriodInMs - on UI.tick uiUpdateTimer . const $ + on_ UI.tick uiUpdateTimer do addPoints tracerEnv history datasetIndices dataName chartId return uiUpdateTimer where diff --git a/cardano-tracer/src/Cardano/Tracer/Handlers/RTView/UI/HTML/Logs.hs b/cardano-tracer/src/Cardano/Tracer/Handlers/RTView/UI/HTML/Logs.hs index 946fefc6dd7..dd45f3f3ff4 100644 --- a/cardano-tracer/src/Cardano/Tracer/Handlers/RTView/UI/HTML/Logs.hs +++ b/cardano-tracer/src/Cardano/Tracer/Handlers/RTView/UI/HTML/Logs.hs @@ -76,7 +76,7 @@ mkLogsLiveView tracerEnv = do # set min_ "1" # set max_ "6" # set value "5" - on change fontSetter . const $ do + on_ change fontSetter do window <- askWindow fontSizePct <- get value fontSetter >>= \case @@ -147,7 +147,7 @@ mkLogsLiveView tracerEnv = do -} ] ] - on UI.click closeIt . const $ do + on_ UI.click closeIt do void $ element logsLiveViewTable #. "modal" void $ element logsLiveViewTable # set dataState "closed" diff --git a/cardano-tracer/src/Cardano/Tracer/Handlers/RTView/UI/HTML/Main.hs b/cardano-tracer/src/Cardano/Tracer/Handlers/RTView/UI/HTML/Main.hs index 0c1f6d7d933..2d386a7c37c 100644 --- a/cardano-tracer/src/Cardano/Tracer/Handlers/RTView/UI/HTML/Main.hs +++ b/cardano-tracer/src/Cardano/Tracer/Handlers/RTView/UI/HTML/Main.hs @@ -9,10 +9,9 @@ import Cardano.Tracer.Environment import Cardano.Tracer.Handlers.RTView.State.Displayed import Cardano.Tracer.Handlers.RTView.State.EraSettings import Cardano.Tracer.Handlers.RTView.State.Peers -import Cardano.Tracer.Handlers.RTView.State.TraceObjects -import Cardano.Tracer.Handlers.RTView.UI.Charts import Cardano.Tracer.Handlers.RTView.UI.CSS.Bulma import Cardano.Tracer.Handlers.RTView.UI.CSS.Own +import Cardano.Tracer.Handlers.RTView.UI.Charts import Cardano.Tracer.Handlers.RTView.UI.HTML.Body import Cardano.Tracer.Handlers.RTView.UI.Img.Icons import Cardano.Tracer.Handlers.RTView.UI.Notifications @@ -21,11 +20,12 @@ import Cardano.Tracer.Handlers.RTView.UI.Utils import Cardano.Tracer.Handlers.RTView.Update.EKG import Cardano.Tracer.Handlers.RTView.Update.KES import Cardano.Tracer.Handlers.RTView.Update.Logs -import Cardano.Tracer.Handlers.RTView.Update.Nodes import Cardano.Tracer.Handlers.RTView.Update.NodeState +import Cardano.Tracer.Handlers.RTView.Update.Nodes import Cardano.Tracer.Handlers.RTView.Update.Peers import Cardano.Tracer.Handlers.RTView.Update.Reload -import Cardano.Tracer.Handlers.RTView.Update.Utils +import Cardano.Tracer.Handlers.State.TraceObjects +import Cardano.Tracer.Handlers.Utils import Control.Concurrent.STM.TVar (readTVarIO) import Control.Monad (void) @@ -39,6 +39,7 @@ import Graphics.UI.Threepenny.Core mkMainPage :: TracerEnv + -> TracerEnvRTView -> DisplayedElements -> ErasSettings -> PageReloadedFlag @@ -46,7 +47,7 @@ mkMainPage -> Network -> UI.Window -> UI () -mkMainPage tracerEnv displayedElements nodesEraSettings reloadFlag +mkMainPage tracerEnv tracerEnvRTView displayedElements nodesEraSettings reloadFlag loggingConfig networkConfig window = do void $ return window # set UI.title pageTitle void $ UI.getHead window #+ @@ -68,13 +69,13 @@ mkMainPage tracerEnv displayedElements nodesEraSettings reloadFlag datasetIndices <- initDatasetsIndices peers <- liftIO initPeers - webPageIsOpened tracerEnv + webPageIsOpened tracerEnvRTView - pageBody <- mkPageBody tracerEnv networkConfig datasetIndices + pageBody <- mkPageBody tracerEnv tracerEnvRTView networkConfig datasetIndices -- Prepare and run the timer, which will hide the page preloader. preloaderTimer <- UI.timer # set UI.interval 10 - on UI.tick preloaderTimer . const $ do + on_ UI.tick preloaderTimer do liftIO $ sleep 0.8 findAndSet (set UI.class_ "pageloader") window "preloader" UI.stop preloaderTimer @@ -86,7 +87,7 @@ mkMainPage tracerEnv displayedElements nodesEraSettings reloadFlag restoreEventsSettings tracerEnv uiNoNodesProgressTimer <- UI.timer # set UI.interval 1000 - on UI.tick uiNoNodesProgressTimer . const $ do + on_ UI.tick uiNoNodesProgressTimer do let elId = "no-nodes-progress" valueS <- findAndGetValue window elId let valueI = readInt (pack valueS) 0 @@ -96,7 +97,7 @@ mkMainPage tracerEnv displayedElements nodesEraSettings reloadFlag UI.stop uiNoNodesProgressTimer findAndSet hiddenOnly window elId - whenM (liftIO $ readTVarIO reloadFlag) $ do + whenM (liftIO $ readTVarIO reloadFlag) do liftIO $ cleanupDisplayedValues displayedElements updateUIAfterReload @@ -112,20 +113,20 @@ mkMainPage tracerEnv displayedElements nodesEraSettings reloadFlag llvCounters <- liftIO initLogsLiveViewCounters uiLogsLiveViewTimer <- UI.timer # set UI.interval 1000 - on UI.tick uiLogsLiveViewTimer . const $ - updateLogsLiveViewItems tracerEnv llvCounters + on_ UI.tick uiLogsLiveViewTimer do + updateLogsLiveViewItems tracerEnv tracerEnvRTView llvCounters -- Uptime is a real-time clock, so update it every second. uiUptimeTimer <- UI.timer # set UI.interval 1000 - on UI.tick uiUptimeTimer . const $ + on_ UI.tick uiUptimeTimer do updateNodesUptime tracerEnv displayedElements uiEKGTimer <- UI.timer # set UI.interval 1000 - on UI.tick uiEKGTimer . const $ + on_ UI.tick uiEKGTimer do updateEKGMetrics tracerEnv uiNodesTimer <- UI.timer # set UI.interval 1000 - on UI.tick uiNodesTimer . const $ do + on_ UI.tick uiNodesTimer do updateNodesUI tracerEnv displayedElements @@ -136,7 +137,7 @@ mkMainPage tracerEnv displayedElements nodesEraSettings reloadFlag uiNoNodesProgressTimer uiPeersTimer <- UI.timer # set UI.interval 4000 - on UI.tick uiPeersTimer . const $ do + on_ UI.tick uiPeersTimer do askNSetNodeState tracerEnv displayedElements updateNodesPeers tracerEnv peers updateKESInfo tracerEnv nodesEraSettings displayedElements @@ -148,8 +149,8 @@ mkMainPage tracerEnv displayedElements nodesEraSettings reloadFlag UI.start uiEKGTimer UI.start uiNoNodesProgressTimer - on UI.disconnect window . const $ do - webPageIsClosed tracerEnv + on_ UI.disconnect window do + webPageIsClosed tracerEnvRTView UI.stop uiLogsLiveViewTimer UI.stop uiNodesTimer UI.stop uiUptimeTimer diff --git a/cardano-tracer/src/Cardano/Tracer/Handlers/RTView/UI/HTML/NoNodes.hs b/cardano-tracer/src/Cardano/Tracer/Handlers/RTView/UI/HTML/NoNodes.hs index eab6d858154..23805b5e6e5 100644 --- a/cardano-tracer/src/Cardano/Tracer/Handlers/RTView/UI/HTML/NoNodes.hs +++ b/cardano-tracer/src/Cardano/Tracer/Handlers/RTView/UI/HTML/NoNodes.hs @@ -27,7 +27,8 @@ mkNoNodesInfo :: Network -> UI Element mkNoNodesInfo networkConfig = do window <- askWindow closeIt <- UI.button #. "delete" # set (UI.attr "aria-label") "delete" - on UI.click closeIt . const $ findAndHide window "no-nodes-info" + on_ UI.click closeIt do + findAndHide window "no-nodes-info" UI.div ## "no-nodes" #. "container is-max-widescreen" #+ [ UI.p #. "has-text-centered" #+ diff --git a/cardano-tracer/src/Cardano/Tracer/Handlers/RTView/UI/HTML/Node/Column.hs b/cardano-tracer/src/Cardano/Tracer/Handlers/RTView/UI/HTML/Node/Column.hs index 878c3c6443a..0252afa9521 100644 --- a/cardano-tracer/src/Cardano/Tracer/Handlers/RTView/UI/HTML/Node/Column.hs +++ b/cardano-tracer/src/Cardano/Tracer/Handlers/RTView/UI/HTML/Node/Column.hs @@ -50,13 +50,15 @@ addNodeColumn tracerEnv loggingConfig nodeId@(NodeId anId) = do #. "button is-info" # set UI.enabled False # set text "Details" - on UI.click peersDetailsButton . const $ fadeInModal peersTable + on_ UI.click peersDetailsButton do + fadeInModal peersTable ekgMetricsWindow <- mkEKGMetricsWindow id' ekgMetricsButton <- UI.button ## (id' <> "__node-ekg-metrics-button") #. "button is-info" # set text "Details" - on UI.click ekgMetricsButton . const $ fadeInModal ekgMetricsWindow + on_ UI.click ekgMetricsButton do + fadeInModal ekgMetricsWindow addNodeCellH "name" [ image "rt-view-node-chart-label has-tooltip-multiline has-tooltip-left" rectangleSVG ## (id' <> "__node-chart-label") @@ -352,7 +354,7 @@ logsSettings loggingConfig nodeName = copyPath <- UI.button #. "button is-info" #+ [image "rt-view-copy-icon-on-button" copySVG] - on UI.click copyPath . const $ + on_ UI.click copyPath do copyTextToClipboard pathToSubdir return $ @@ -374,7 +376,7 @@ logsSettings loggingConfig nodeName = JournalMode -> do copyId <- UI.button #. "button is-info" #+ [image "rt-view-copy-icon" copySVG] - on UI.click copyId . const $ + on_ UI.click copyId do copyTextToClipboard (unpack nodeName) return $ diff --git a/cardano-tracer/src/Cardano/Tracer/Handlers/RTView/UI/HTML/Node/EKG.hs b/cardano-tracer/src/Cardano/Tracer/Handlers/RTView/UI/HTML/Node/EKG.hs index c0e75962c3b..6dadd7df6ac 100644 --- a/cardano-tracer/src/Cardano/Tracer/Handlers/RTView/UI/HTML/Node/EKG.hs +++ b/cardano-tracer/src/Cardano/Tracer/Handlers/RTView/UI/HTML/Node/EKG.hs @@ -44,5 +44,6 @@ mkEKGMetricsWindow anId = do ] ] ] - on UI.click closeIt . const $ element metricsWindow #. "modal" + on_ UI.click closeIt do + element metricsWindow #. "modal" return metricsWindow diff --git a/cardano-tracer/src/Cardano/Tracer/Handlers/RTView/UI/HTML/Node/Peers.hs b/cardano-tracer/src/Cardano/Tracer/Handlers/RTView/UI/HTML/Node/Peers.hs index a918bbbf6e3..76d95ef1d09 100644 --- a/cardano-tracer/src/Cardano/Tracer/Handlers/RTView/UI/HTML/Node/Peers.hs +++ b/cardano-tracer/src/Cardano/Tracer/Handlers/RTView/UI/HTML/Node/Peers.hs @@ -48,7 +48,8 @@ mkPeersTable anId = do ] ] ] - on UI.click closeIt . const $ element peerTable #. "modal" + on_ UI.click closeIt do + element peerTable #. "modal" return peerTable -- | The peer was disconnected, so its row should be deleted. diff --git a/cardano-tracer/src/Cardano/Tracer/Handlers/RTView/UI/HTML/Notifications.hs b/cardano-tracer/src/Cardano/Tracer/Handlers/RTView/UI/HTML/Notifications.hs index bd23398192f..187d69ce457 100644 --- a/cardano-tracer/src/Cardano/Tracer/Handlers/RTView/UI/HTML/Notifications.hs +++ b/cardano-tracer/src/Cardano/Tracer/Handlers/RTView/UI/HTML/Notifications.hs @@ -7,10 +7,10 @@ module Cardano.Tracer.Handlers.RTView.UI.HTML.Notifications ) where import Cardano.Tracer.Environment -import Cardano.Tracer.Handlers.RTView.Notifications.Email -import Cardano.Tracer.Handlers.RTView.Notifications.Timer -import Cardano.Tracer.Handlers.RTView.Notifications.Types -import Cardano.Tracer.Handlers.RTView.Notifications.Utils +import Cardano.Tracer.Handlers.Notifications.Email +import Cardano.Tracer.Handlers.Notifications.Timer +import Cardano.Tracer.Handlers.Notifications.Types +import Cardano.Tracer.Handlers.Notifications.Utils import Cardano.Tracer.Handlers.RTView.UI.Img.Icons import Cardano.Tracer.Handlers.RTView.UI.Notifications import Cardano.Tracer.Handlers.RTView.UI.Utils @@ -89,36 +89,36 @@ mkNotificationsEvents tracerEnv eventsQueues = do ] ] - on UI.click closeIt . const $ do + on UI.click closeIt \_ -> do void $ element notifications #. "modal" saveEventsSettings tracerEnv - on UI.checkedChange switchWarnings $ \state -> do + on UI.checkedChange switchWarnings \state -> do setNotifyIconState saveEventsSettings tracerEnv liftIO $ updateNotificationsEvents eventsQueues EventWarnings state - on UI.checkedChange switchErrors $ \state -> do + on UI.checkedChange switchErrors \state -> do setNotifyIconState saveEventsSettings tracerEnv liftIO $ updateNotificationsEvents eventsQueues EventErrors state - on UI.checkedChange switchCriticals $ \state -> do + on UI.checkedChange switchCriticals \state -> do setNotifyIconState saveEventsSettings tracerEnv liftIO $ updateNotificationsEvents eventsQueues EventCriticals state - on UI.checkedChange switchAlerts $ \state -> do + on UI.checkedChange switchAlerts \state -> do setNotifyIconState saveEventsSettings tracerEnv liftIO $ updateNotificationsEvents eventsQueues EventAlerts state - on UI.checkedChange switchEmergencies $ \state -> do + on UI.checkedChange switchEmergencies \state -> do setNotifyIconState saveEventsSettings tracerEnv liftIO $ updateNotificationsEvents eventsQueues EventEmergencies state - on UI.checkedChange switchNodeDiscon $ \state -> do + on UI.checkedChange switchNodeDiscon \state -> do setNotifyIconState saveEventsSettings tracerEnv liftIO $ updateNotificationsEvents eventsQueues EventNodeDisconnected state - on UI.checkedChange switchAll $ \state -> do + on UI.checkedChange switchAll \state -> do void $ element switchWarnings # set UI.checked state void $ element switchErrors # set UI.checked state void $ element switchCriticals # set UI.checked state @@ -147,8 +147,8 @@ mkNotificationsEvents tracerEnv eventsQueues = do return notifications where handleSelectChange selector eventGroup = - on UI.selectionChange selector . const $ - whenJustM (readMaybe <$> get value selector) $ \(period :: PeriodInSec) -> + on_ UI.selectionChange selector do + whenJustM (readMaybe <$> get value selector) \(period :: PeriodInSec) -> liftIO $ updateNotificationsPeriods eventsQueues eventGroup period mkDivider :: String -> UI Element @@ -316,12 +316,12 @@ mkNotificationsSettings tracerEnv = do ] ] - on UI.click closeIt . const $ do + on_ UI.click closeIt do void $ element notifications #. "modal" void $ element sendTestEmailStatus # set text "" saveEmailSettings tracerEnv - on UI.click sendTestEmail . const $ do + on_ UI.click sendTestEmail do void $ element sendTestEmailStatus # set text "" void $ element sendTestEmail #. "button is-primary is-loading" # set UI.enabled False @@ -335,7 +335,7 @@ mkNotificationsSettings tracerEnv = do void $ element sendTestEmail #. "button is-primary" # set UI.enabled True - on UI.click showHidePassword . const $ do + on_ UI.click showHidePassword do state <- get dataState showHidePassword let haveToHide = state == shownState if haveToHide @@ -348,11 +348,11 @@ mkNotificationsSettings tracerEnv = do void $ element showHidePassword # set dataState shownState void $ element inputPassword # set UI.type_ "text" - on UI.valueChange inputHost $ const setStatusTestEmailButton - on UI.valueChange inputUser $ const setStatusTestEmailButton - on UI.valueChange inputPassword $ const setStatusTestEmailButton - on UI.valueChange inputEmailFrom $ const setStatusTestEmailButton - on UI.valueChange inputEmailTo $ const setStatusTestEmailButton + on_ UI.valueChange inputHost do setStatusTestEmailButton + on_ UI.valueChange inputUser do setStatusTestEmailButton + on_ UI.valueChange inputPassword do setStatusTestEmailButton + on_ UI.valueChange inputEmailFrom do setStatusTestEmailButton + on_ UI.valueChange inputEmailTo do setStatusTestEmailButton return notifications diff --git a/cardano-tracer/src/Cardano/Tracer/Handlers/RTView/UI/JS/Charts.hs b/cardano-tracer/src/Cardano/Tracer/Handlers/RTView/UI/JS/Charts.hs index 3858cf40966..568366bb1d3 100644 --- a/cardano-tracer/src/Cardano/Tracer/Handlers/RTView/UI/JS/Charts.hs +++ b/cardano-tracer/src/Cardano/Tracer/Handlers/RTView/UI/JS/Charts.hs @@ -17,7 +17,7 @@ module Cardano.Tracer.Handlers.RTView.UI.JS.Charts import Cardano.Tracer.Handlers.RTView.State.Historical import Cardano.Tracer.Handlers.RTView.UI.Types -import Cardano.Tracer.Handlers.RTView.Update.Utils +import Cardano.Tracer.Handlers.Utils import Data.List (intercalate) import Data.String.QQ diff --git a/cardano-tracer/src/Cardano/Tracer/Handlers/RTView/UI/Logs.hs b/cardano-tracer/src/Cardano/Tracer/Handlers/RTView/UI/Logs.hs index 57fd9803053..35ff3d55076 100644 --- a/cardano-tracer/src/Cardano/Tracer/Handlers/RTView/UI/Logs.hs +++ b/cardano-tracer/src/Cardano/Tracer/Handlers/RTView/UI/Logs.hs @@ -7,8 +7,8 @@ module Cardano.Tracer.Handlers.RTView.UI.Logs ) where import Cardano.Tracer.Environment -import Cardano.Tracer.Handlers.RTView.System import Cardano.Tracer.Handlers.RTView.UI.Utils +import Cardano.Tracer.Handlers.System import Control.Exception.Extra (ignore, try_) import qualified Data.Text as T diff --git a/cardano-tracer/src/Cardano/Tracer/Handlers/RTView/UI/Notifications.hs b/cardano-tracer/src/Cardano/Tracer/Handlers/RTView/UI/Notifications.hs index 2b330e520f5..88a31e0cefc 100644 --- a/cardano-tracer/src/Cardano/Tracer/Handlers/RTView/UI/Notifications.hs +++ b/cardano-tracer/src/Cardano/Tracer/Handlers/RTView/UI/Notifications.hs @@ -14,13 +14,13 @@ module Cardano.Tracer.Handlers.RTView.UI.Notifications ) where import Cardano.Tracer.Environment -import Cardano.Tracer.Handlers.RTView.Notifications.Settings -import Cardano.Tracer.Handlers.RTView.Notifications.Timer -import Cardano.Tracer.Handlers.RTView.Notifications.Types +import Cardano.Tracer.Handlers.Notifications.Settings +import Cardano.Tracer.Handlers.Notifications.Timer +import Cardano.Tracer.Handlers.Notifications.Types import Cardano.Tracer.Handlers.RTView.UI.Img.Icons import Cardano.Tracer.Handlers.RTView.UI.JS.Utils import Cardano.Tracer.Handlers.RTView.UI.Utils -import Cardano.Tracer.Handlers.RTView.Update.Utils +import Cardano.Tracer.Handlers.Utils import Control.Monad (unless, when) import Data.Maybe (fromMaybe) @@ -32,8 +32,8 @@ import qualified Graphics.UI.Threepenny as UI import Graphics.UI.Threepenny.Core restoreEmailSettings :: TracerEnv -> UI () -restoreEmailSettings TracerEnv{teRTViewStateDir} = do - eSettings <- liftIO $ readSavedEmailSettings teRTViewStateDir +restoreEmailSettings TracerEnv{teStateDir} = do + eSettings <- liftIO $ readSavedEmailSettings teStateDir setEmailSettings eSettings setStatusTestEmailButton where @@ -53,8 +53,8 @@ restoreEmailSettings TracerEnv{teRTViewStateDir} = do findAndSet (set value elValue) window elId restoreEventsSettings :: TracerEnv -> UI () -restoreEventsSettings TracerEnv{teRTViewStateDir} = do - eSettings <- liftIO $ readSavedEventsSettings teRTViewStateDir +restoreEventsSettings TracerEnv{teStateDir} = do + eSettings <- liftIO $ readSavedEventsSettings teStateDir setEventsSettings eSettings setNotifyIconState setSwitchAllState eSettings diff --git a/cardano-tracer/src/Cardano/Tracer/Handlers/RTView/UI/Theme.hs b/cardano-tracer/src/Cardano/Tracer/Handlers/RTView/UI/Theme.hs index 91e1d65aede..6a41790e924 100644 --- a/cardano-tracer/src/Cardano/Tracer/Handlers/RTView/UI/Theme.hs +++ b/cardano-tracer/src/Cardano/Tracer/Handlers/RTView/UI/Theme.hs @@ -10,10 +10,10 @@ module Cardano.Tracer.Handlers.RTView.UI.Theme ) where import Cardano.Tracer.Environment -import Cardano.Tracer.Handlers.RTView.System import Cardano.Tracer.Handlers.RTView.UI.Charts import Cardano.Tracer.Handlers.RTView.UI.Img.Icons import Cardano.Tracer.Handlers.RTView.UI.Utils +import Cardano.Tracer.Handlers.System import Control.Exception.Extra (ignore, try_) import Control.Monad (void) diff --git a/cardano-tracer/src/Cardano/Tracer/Handlers/RTView/UI/Utils.hs b/cardano-tracer/src/Cardano/Tracer/Handlers/RTView/UI/Utils.hs index c01009d3bf1..cb8b624d436 100644 --- a/cardano-tracer/src/Cardano/Tracer/Handlers/RTView/UI/Utils.hs +++ b/cardano-tracer/src/Cardano/Tracer/Handlers/RTView/UI/Utils.hs @@ -1,4 +1,5 @@ {-# LANGUAGE LambdaCase #-} +{-# LANGUAGE CPP #-} {-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE QuasiQuotes #-} @@ -48,6 +49,7 @@ module Cardano.Tracer.Handlers.RTView.UI.Utils , hiddenState , webPageIsOpened , webPageIsClosed + , on_ ) where import Cardano.Tracer.Environment @@ -302,9 +304,13 @@ exportErrorsToJSONFile nodesErrors nodeId nodeName = downloadJSONFile fileName errorsAsJSON -} -webPageIsOpened, webPageIsClosed :: TracerEnv -> UI () -webPageIsOpened TracerEnv{teRTViewPageOpened} = setFlag teRTViewPageOpened True -webPageIsClosed TracerEnv{teRTViewPageOpened} = setFlag teRTViewPageOpened False +webPageIsOpened, webPageIsClosed :: TracerEnvRTView -> UI () +webPageIsOpened TracerEnvRTView{teRTViewPageOpened} = setFlag teRTViewPageOpened True +webPageIsClosed TracerEnvRTView{teRTViewPageOpened} = setFlag teRTViewPageOpened False setFlag :: TVar Bool -> Bool -> UI () setFlag flag state = liftIO . atomically . modifyTVar' flag $ const state + +-- | A version of @on@ that ignores the result of the event. +on_ :: (element -> Event a) -> element -> UI void -> UI () +on_ event el action = on event el do const action diff --git a/cardano-tracer/src/Cardano/Tracer/Handlers/RTView/Update/EraSettings.hs b/cardano-tracer/src/Cardano/Tracer/Handlers/RTView/Update/EraSettings.hs index cbe407086bc..14707c26161 100644 --- a/cardano-tracer/src/Cardano/Tracer/Handlers/RTView/Update/EraSettings.hs +++ b/cardano-tracer/src/Cardano/Tracer/Handlers/RTView/Update/EraSettings.hs @@ -9,7 +9,7 @@ module Cardano.Tracer.Handlers.RTView.Update.EraSettings import Cardano.Node.Startup (NodeStartupInfo (..)) import Cardano.Tracer.Environment import Cardano.Tracer.Handlers.RTView.State.EraSettings -import Cardano.Tracer.Handlers.RTView.Update.Utils +import Cardano.Tracer.Handlers.Utils import Cardano.Tracer.Handlers.RTView.Utils import Control.Monad (forever) diff --git a/cardano-tracer/src/Cardano/Tracer/Handlers/RTView/Update/Historical.hs b/cardano-tracer/src/Cardano/Tracer/Handlers/RTView/Update/Historical.hs index b5ab9b730e8..4094c1dc64f 100644 --- a/cardano-tracer/src/Cardano/Tracer/Handlers/RTView/Update/Historical.hs +++ b/cardano-tracer/src/Cardano/Tracer/Handlers/RTView/Update/Historical.hs @@ -1,4 +1,5 @@ {-# LANGUAGE BangPatterns #-} +{-# LANGUAGE CPP #-} {-# LANGUAGE LambdaCase #-} {-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE ScopedTypeVariables #-} @@ -17,13 +18,13 @@ import Cardano.Tracer.Environment import Cardano.Tracer.Handlers.Metrics.Utils import Cardano.Tracer.Handlers.RTView.State.Historical import Cardano.Tracer.Handlers.RTView.State.Last -import Cardano.Tracer.Handlers.RTView.System import Cardano.Tracer.Handlers.RTView.Update.Chain import Cardano.Tracer.Handlers.RTView.Update.Leadership import Cardano.Tracer.Handlers.RTView.Update.Resources import Cardano.Tracer.Handlers.RTView.Update.Transactions -import Cardano.Tracer.Handlers.RTView.Update.Utils import Cardano.Tracer.Handlers.RTView.Utils +import Cardano.Tracer.Handlers.System +import Cardano.Tracer.Handlers.Utils import Cardano.Tracer.Types import Cardano.Tracer.Utils @@ -64,31 +65,32 @@ import Text.Read (readMaybe) -- runHistoricalUpdater :: TracerEnv + -> TracerEnvRTView -> LastResources -> IO () -runHistoricalUpdater tracerEnv lastResources = forever $ do +runHistoricalUpdater tracerEnv tracerEnvRTView lastResources = forever do sleep 1.0 -- TODO: should it be configured? now <- systemToUTCTime <$> getSystemTime - forAcceptedMetrics_ tracerEnv $ \(nodeId, (ekgStore, _)) -> - forMM_ (getListOfMetrics ekgStore) $ \(metricName, metricValue) -> do + forAcceptedMetrics_ tracerEnv \(nodeId, (ekgStore, _)) -> + forMM_ (getListOfMetrics ekgStore) \(metricName, metricValue) -> do updateTransactionsHistory nodeId teTxHistory metricName metricValue now updateResourcesHistory nodeId teResourcesHistory lastResources metricName metricValue now updateBlockchainHistory nodeId teBlockchainHistory metricName metricValue now updateLeadershipHistory nodeId teBlockchainHistory metricName metricValue now where - TracerEnv{teTxHistory, teResourcesHistory, teBlockchainHistory} = tracerEnv + TracerEnvRTView{teTxHistory, teResourcesHistory, teBlockchainHistory} = tracerEnvRTView -- | If RTView's web page is opened, historical backup is performing by UI-code, -- in this case we should skip backup. -runHistoricalBackup :: TracerEnv -> IO () -runHistoricalBackup tracerEnv@TracerEnv{teRTViewPageOpened} = forever $ do +runHistoricalBackup :: TracerEnv -> TracerEnvRTView -> IO () +runHistoricalBackup tracerEnv tracerEnvRTView@TracerEnvRTView{teRTViewPageOpened} = forever do sleep 300.0 -- TODO: 5 minutes, should it be changed? ifM (readTVarIO teRTViewPageOpened) (return ()) -- Skip, UI-code is performing backup. - (backupAllHistory tracerEnv) + (backupAllHistory tracerEnv tracerEnvRTView) -backupAllHistory :: TracerEnv -> IO () -backupAllHistory tracerEnv@TracerEnv{teConnectedNodes} = do +backupAllHistory :: TracerEnv -> TracerEnvRTView -> IO () +backupAllHistory tracerEnv@TracerEnv{teConnectedNodes} tracerEnvRTView = do connected <- S.toList <$> readTVarIO teConnectedNodes nodesIdsWithNames <- getNodesIdsWithNames tracerEnv connected backupDir <- getPathToBackupDir tracerEnv @@ -97,7 +99,7 @@ backupAllHistory tracerEnv@TracerEnv{teConnectedNodes} = do <*> readTVar resourcesHistory <*> readTVar txHistory -- We can safely work with files for different nodes concurrently. - forConcurrently_ nodesIdsWithNames $ \(nodeId, nodeName) -> do + forConcurrently_ nodesIdsWithNames \(nodeId, nodeName) -> do backupHistory backupDir cHistory nodeId nodeName Nothing backupHistory backupDir rHistory nodeId nodeName Nothing backupHistory backupDir tHistory nodeId nodeName Nothing @@ -107,13 +109,17 @@ backupAllHistory tracerEnv@TracerEnv{teConnectedNodes} = do cleanupHistoryPoints resourcesHistory cleanupHistoryPoints txHistory where - TracerEnv{teBlockchainHistory, teResourcesHistory, teTxHistory} = tracerEnv - ChainHistory chainHistory = teBlockchainHistory - ResHistory resourcesHistory = teResourcesHistory - TXHistory txHistory = teTxHistory + TracerEnvRTView{teResourcesHistory, teBlockchainHistory, teTxHistory} + = tracerEnvRTView + ChainHistory chainHistory + = teBlockchainHistory + ResHistory resourcesHistory + = teResourcesHistory + TXHistory txHistory + = teTxHistory -- Remove sets of historical points only, because they are already backed up. - cleanupHistoryPoints history = atomically $ + cleanupHistoryPoints history = atomically do modifyTVar' history $ M.map (M.map (const S.empty)) -- | Backup specific history after these points were pushed to corresponding JS-chart. @@ -127,13 +133,13 @@ backupSpecificHistory backupSpecificHistory tracerEnv history connected dataName = do backupDir <- getPathToBackupDir tracerEnv hist <- readTVarIO history - forMM_ (getNodesIdsWithNames tracerEnv connected) $ \(nodeId, nodeName) -> do + forMM_ (getNodesIdsWithNames tracerEnv connected) \(nodeId, nodeName) -> do backupHistory backupDir hist nodeId nodeName $ Just dataName cleanupSpecificHistoryPoints nodeId where - cleanupSpecificHistoryPoints nodeId = atomically $ + cleanupSpecificHistoryPoints nodeId = atomically do -- Removes only the points for 'nodeId' and 'dataName'. - modifyTVar' history $ \currentHistory -> + modifyTVar' history \currentHistory -> case M.lookup nodeId currentHistory of Nothing -> currentHistory Just dataForNode -> @@ -151,7 +157,7 @@ backupHistory -> Maybe DataName -> IO () backupHistory backupDir history nodeId nodeName mDataName = - whenJust (M.lookup nodeId history) $ \historyData -> ignore $ do + whenJust (M.lookup nodeId history) \historyData -> ignore do let nodeSubdir = backupDir T.unpack nodeName createDirectoryIfMissing True nodeSubdir case mDataName of @@ -178,7 +184,7 @@ getAllHistoryFromBackup tracerEnv@TracerEnv{teConnectedNodes} dataName = do connected <- S.toList <$> readTVarIO teConnectedNodes nodesIdsWithNames <- getNodesIdsWithNames tracerEnv connected backupDir <- getPathToBackupDir tracerEnv - forM nodesIdsWithNames $ \(nodeId, nodeName) -> do + forM nodesIdsWithNames \(nodeId, nodeName) -> do let nodeSubdir = backupDir T.unpack nodeName doesDirectoryExist nodeSubdir >>= \case False -> return (nodeId, []) -- There is no backup for this node. @@ -218,7 +224,7 @@ getLastHistoryFromBackups' -> IO [(NodeId, [(DataName, [HistoricalPoint])])] getLastHistoryFromBackups' tracerEnv nodeIds = do backupDir <- getPathToBackupDir tracerEnv - forMM (getNodesIdsWithNames tracerEnv nodeIds) $ \(nodeId, nodeName) -> do + forMM (getNodesIdsWithNames tracerEnv nodeIds) \(nodeId, nodeName) -> do let nodeSubdir = backupDir T.unpack nodeName doesDirectoryExist nodeSubdir >>= \case False -> return (nodeId, []) -- There is no backup for this node. @@ -254,6 +260,6 @@ getNodesIdsWithNames -> IO [(NodeId, NodeName)] getNodesIdsWithNames _ [] = return [] getNodesIdsWithNames tracerEnv connected = - forM connected $ \nodeId -> do + forM connected \nodeId -> do nodeName <- askNodeName tracerEnv nodeId return (nodeId, nodeName) diff --git a/cardano-tracer/src/Cardano/Tracer/Handlers/RTView/Update/Logs.hs b/cardano-tracer/src/Cardano/Tracer/Handlers/RTView/Update/Logs.hs index 25a04fed56b..3c97a6bae49 100644 --- a/cardano-tracer/src/Cardano/Tracer/Handlers/RTView/Update/Logs.hs +++ b/cardano-tracer/src/Cardano/Tracer/Handlers/RTView/Update/Logs.hs @@ -11,7 +11,6 @@ module Cardano.Tracer.Handlers.RTView.Update.Logs import Cardano.Logging (SeverityS (..), showT) import Cardano.Tracer.Environment -import Cardano.Tracer.Handlers.RTView.State.TraceObjects import Cardano.Tracer.Handlers.RTView.UI.Charts import Cardano.Tracer.Handlers.RTView.UI.Img.Icons import Cardano.Tracer.Handlers.RTView.UI.JS.Utils @@ -19,6 +18,7 @@ import Cardano.Tracer.Handlers.RTView.UI.Types import Cardano.Tracer.Handlers.RTView.UI.Utils import Cardano.Tracer.Handlers.RTView.Update.Nodes import Cardano.Tracer.Handlers.RTView.Utils +import Cardano.Tracer.Handlers.State.TraceObjects import Cardano.Tracer.Types import Cardano.Tracer.Utils @@ -33,21 +33,22 @@ import Graphics.UI.Threepenny.Core updateLogsLiveViewItems :: TracerEnv + -> TracerEnvRTView -> LogsLiveViewCounters -> UI () -updateLogsLiveViewItems tracerEnv@TracerEnv{teSavedTO} llvCounters = - whenM logsLiveViewIsOpened $ do +updateLogsLiveViewItems tracerEnv TracerEnvRTView{teSavedTO} llvCounters = + whenM logsLiveViewIsOpened do window <- askWindow - whenJustM (UI.getElementById window "node-logs-live-view-tbody") $ \el -> - forConnectedUI_ tracerEnv $ \nodeId@(NodeId anId) -> do + whenJustM (UI.getElementById window "node-logs-live-view-tbody") \el -> + forConnectedUI_ tracerEnv \nodeId@(NodeId anId) -> do nodeName <- liftIO $ askNodeName tracerEnv nodeId nodeColor <- liftIO $ getSavedColorForNode tracerEnv nodeName tosFromThisNode <- liftIO $ getTraceObjects teSavedTO nodeId - forM_ tosFromThisNode $ \trObInfo -> do + forM_ tosFromThisNode \trObInfo -> do -- We should add log items only for nodes which is "enabled" via checkbox. let checkId = T.unpack anId <> "__node-live-view-checkbox" - whenJustM (UI.getElementById window checkId) $ \checkbox -> do - whenM (get UI.checked checkbox) $ do + whenJustM (UI.getElementById window checkId) \checkbox -> do + whenM (get UI.checked checkbox) do doAddItemRow nodeId nodeName nodeColor llvCounters el trObInfo -- Since we have added a new item row, we have to check if there are -- too many items already. If so - we have to remove old item row, @@ -56,7 +57,7 @@ updateLogsLiveViewItems tracerEnv@TracerEnv{teSavedTO} llvCounters = liftIO (getLogsLiveViewCounter llvCounters nodeId) >>= \case Nothing -> return () Just currentNumber -> - when (currentNumber > maxNumberOfLogsLiveViewItems) $ do + when (currentNumber > maxNumberOfLogsLiveViewItems) do -- Ok, we have to delete outdated item row. let !outdatedItemNumber = currentNumber - maxNumberOfLogsLiveViewItems outdatedItemId = nodeName <> "llv" <> showT outdatedItemNumber @@ -89,8 +90,9 @@ doAddItemRow nodeId@(NodeId anId) nodeName nodeColor mkItemRow = do copyItemIcon <- image "has-tooltip-multiline has-tooltip-left rt-view-copy-icon" copySVG # set dataTooltip "Click to copy this log item" - on UI.click copyItemIcon . const $ copyTextToClipboard $ - "[" <> preparedTS ts <> "] [" <> show sev <> "] [" <> T.unpack ns <> "] [" <> T.unpack msg <> "]" + on_ UI.click copyItemIcon do + copyTextToClipboard $ + "[" <> preparedTS ts <> "] [" <> show sev <> "] [" <> T.unpack ns <> "] [" <> T.unpack msg <> "]" let nodeNamePrepared = T.unpack $ if T.length nodeName > 13 diff --git a/cardano-tracer/src/Cardano/Tracer/Handlers/RTView/Update/NodeInfo.hs b/cardano-tracer/src/Cardano/Tracer/Handlers/RTView/Update/NodeInfo.hs index 1158dedcfd9..7f979972f93 100644 --- a/cardano-tracer/src/Cardano/Tracer/Handlers/RTView/Update/NodeInfo.hs +++ b/cardano-tracer/src/Cardano/Tracer/Handlers/RTView/Update/NodeInfo.hs @@ -9,7 +9,7 @@ import Cardano.Node.Startup (NodeInfo (..)) import Cardano.Tracer.Environment import Cardano.Tracer.Handlers.RTView.State.Displayed import Cardano.Tracer.Handlers.RTView.UI.Utils -import Cardano.Tracer.Handlers.RTView.Update.Utils +import Cardano.Tracer.Handlers.Utils import Cardano.Tracer.Types import Control.Monad (forM_) diff --git a/cardano-tracer/src/Cardano/Tracer/Handlers/RTView/Update/NodeState.hs b/cardano-tracer/src/Cardano/Tracer/Handlers/RTView/Update/NodeState.hs index bb7c031ab37..d9548824d84 100644 --- a/cardano-tracer/src/Cardano/Tracer/Handlers/RTView/Update/NodeState.hs +++ b/cardano-tracer/src/Cardano/Tracer/Handlers/RTView/Update/NodeState.hs @@ -10,7 +10,7 @@ import Cardano.Node.Tracing.StateRep import Cardano.Tracer.Environment import Cardano.Tracer.Handlers.RTView.State.Displayed import Cardano.Tracer.Handlers.RTView.UI.Utils -import Cardano.Tracer.Handlers.RTView.Update.Utils +import Cardano.Tracer.Handlers.Utils import Cardano.Tracer.Handlers.RTView.Utils import Cardano.Tracer.Types diff --git a/cardano-tracer/src/Cardano/Tracer/Handlers/RTView/Update/Nodes.hs b/cardano-tracer/src/Cardano/Tracer/Handlers/RTView/Update/Nodes.hs index f6472ebaf95..75517241e5d 100644 --- a/cardano-tracer/src/Cardano/Tracer/Handlers/RTView/Update/Nodes.hs +++ b/cardano-tracer/src/Cardano/Tracer/Handlers/RTView/Update/Nodes.hs @@ -25,7 +25,7 @@ import Cardano.Tracer.Handlers.RTView.UI.HTML.NoNodes import Cardano.Tracer.Handlers.RTView.UI.Types import Cardano.Tracer.Handlers.RTView.UI.Utils import Cardano.Tracer.Handlers.RTView.Update.NodeInfo -import Cardano.Tracer.Handlers.RTView.Update.Utils +import Cardano.Tracer.Handlers.Utils import Cardano.Tracer.Handlers.RTView.Utils import Cardano.Tracer.Types import Cardano.Tracer.Utils @@ -63,8 +63,8 @@ updateNodesUI -> UI.Timer -> UI () updateNodesUI tracerEnv@TracerEnv{teConnectedNodes, teAcceptedMetrics} - displayedElements nodesEraSettings loggingConfig colors - datasetIndices noNodesProgressTimer = do + displayedElements nodesEraSettings loggingConfig + colors datasetIndices noNodesProgressTimer = do (connected, displayedEls) <- liftIO . atomically $ (,) <$> readTVar teConnectedNodes <*> readTVar displayedElements @@ -184,7 +184,7 @@ addLiveViewNodesForConnected -> Set NodeId -> UI () addLiveViewNodesForConnected tracerEnv newlyConnected = - whenM logsLiveViewIsOpened $ + whenM logsLiveViewIsOpened do doAddLiveViewNodesForConnected tracerEnv newlyConnected doAddLiveViewNodesForConnected @@ -193,8 +193,8 @@ doAddLiveViewNodesForConnected -> UI () doAddLiveViewNodesForConnected tracerEnv connected = do window <- askWindow - whenJustM (UI.getElementById window "logs-live-view-nodes-checkboxes") $ \el -> - forM_ connected $ \nodeId@(NodeId anId) -> do + whenJustM (UI.getElementById window "logs-live-view-nodes-checkboxes") \el -> + forM_ connected \nodeId@(NodeId anId) -> do nodeName <- liftIO $ askNodeName tracerEnv nodeId nodeColor <- liftIO $ getSavedColorForNode tracerEnv nodeName diff --git a/cardano-tracer/src/Cardano/Tracer/Handlers/RTView/Update/Peers.hs b/cardano-tracer/src/Cardano/Tracer/Handlers/RTView/Update/Peers.hs index 75fdd3ff034..def88eff97f 100644 --- a/cardano-tracer/src/Cardano/Tracer/Handlers/RTView/Update/Peers.hs +++ b/cardano-tracer/src/Cardano/Tracer/Handlers/RTView/Update/Peers.hs @@ -17,8 +17,8 @@ import Cardano.Tracer.Environment import Cardano.Tracer.Handlers.RTView.State.Peers import Cardano.Tracer.Handlers.RTView.UI.HTML.Node.Peers import Cardano.Tracer.Handlers.RTView.UI.Utils -import Cardano.Tracer.Handlers.RTView.Update.Utils import Cardano.Tracer.Handlers.RTView.Utils +import Cardano.Tracer.Handlers.Utils import Cardano.Tracer.Types import Control.Monad (forM_, void) diff --git a/cardano-tracer/src/Cardano/Tracer/Handlers/RTView/Update/Reload.hs b/cardano-tracer/src/Cardano/Tracer/Handlers/RTView/Update/Reload.hs index 3084c9684c1..72c20c665f5 100644 --- a/cardano-tracer/src/Cardano/Tracer/Handlers/RTView/Update/Reload.hs +++ b/cardano-tracer/src/Cardano/Tracer/Handlers/RTView/Update/Reload.hs @@ -26,8 +26,8 @@ updateUIAfterReload -> DatasetsIndices -> UI.Timer -> UI () -updateUIAfterReload tracerEnv displayedElements loggingConfig colors - datasetIndices noNodesProgressTimer = do +updateUIAfterReload tracerEnv displayedElements loggingConfig + colors datasetIndices noNodesProgressTimer = do -- Ok, web-page was reload (i.e. it's the first update after DOM-rendering), -- so displayed state should be restored immediately. connected <- liftIO $ readTVarIO (teConnectedNodes tracerEnv) diff --git a/cardano-tracer/src/Cardano/Tracer/Handlers/RTView/Update/Resources.hs b/cardano-tracer/src/Cardano/Tracer/Handlers/RTView/Update/Resources.hs index 5dbd55836e3..7cf114103ec 100644 --- a/cardano-tracer/src/Cardano/Tracer/Handlers/RTView/Update/Resources.hs +++ b/cardano-tracer/src/Cardano/Tracer/Handlers/RTView/Update/Resources.hs @@ -10,7 +10,7 @@ module Cardano.Tracer.Handlers.RTView.Update.Resources import Cardano.Tracer.Handlers.Metrics.Utils import Cardano.Tracer.Handlers.RTView.State.Historical import Cardano.Tracer.Handlers.RTView.State.Last -import Cardano.Tracer.Handlers.RTView.Update.Utils +import Cardano.Tracer.Handlers.Utils import Cardano.Tracer.Types import Control.Concurrent.STM.TVar (readTVarIO) diff --git a/cardano-tracer/src/Cardano/Tracer/Handlers/RTView/SSL/Certs.hs b/cardano-tracer/src/Cardano/Tracer/Handlers/SSL/Certs.hs similarity index 98% rename from cardano-tracer/src/Cardano/Tracer/Handlers/RTView/SSL/Certs.hs rename to cardano-tracer/src/Cardano/Tracer/Handlers/SSL/Certs.hs index 7cfa6a1ff7c..22a386f0599 100644 --- a/cardano-tracer/src/Cardano/Tracer/Handlers/RTView/SSL/Certs.hs +++ b/cardano-tracer/src/Cardano/Tracer/Handlers/SSL/Certs.hs @@ -1,12 +1,12 @@ {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE QuasiQuotes #-} -module Cardano.Tracer.Handlers.RTView.SSL.Certs +module Cardano.Tracer.Handlers.SSL.Certs ( placeDefaultSSLFiles ) where import Cardano.Tracer.Environment -import Cardano.Tracer.Handlers.RTView.System +import Cardano.Tracer.Handlers.System import Control.Exception.Extra (ignore) import Control.Monad.Extra (unlessM) diff --git a/cardano-tracer/src/Cardano/Tracer/Handlers/RTView/State/TraceObjects.hs b/cardano-tracer/src/Cardano/Tracer/Handlers/State/TraceObjects.hs similarity index 92% rename from cardano-tracer/src/Cardano/Tracer/Handlers/RTView/State/TraceObjects.hs rename to cardano-tracer/src/Cardano/Tracer/Handlers/State/TraceObjects.hs index d21adfb2a2a..aad84882262 100644 --- a/cardano-tracer/src/Cardano/Tracer/Handlers/RTView/State/TraceObjects.hs +++ b/cardano-tracer/src/Cardano/Tracer/Handlers/State/TraceObjects.hs @@ -1,7 +1,7 @@ {-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE OverloadedStrings #-} -module Cardano.Tracer.Handlers.RTView.State.TraceObjects +module Cardano.Tracer.Handlers.State.TraceObjects ( LogsLiveViewCounters , Namespace , SavedTraceObjects @@ -57,13 +57,16 @@ saveTraceObjects savedTraceObjects nodeId traceObjects = -- There is a queue for this node already, so fill it. pushItemsToQueue qForThisNode where + itemsToSave :: [(Namespace, TraceObjectInfo)] itemsToSave = mapMaybe getTOValue traceObjects + getTOValue :: TraceObject -> Maybe (Namespace, TraceObjectInfo) getTOValue TraceObject{toNamespace, toHuman, toMachine, toSeverity, toTimestamp} = case (toNamespace, toHuman, toMachine) of ([], _, _) -> Nothing (ns, _, msg) -> Just (mkName ns, (msg, toSeverity, toTimestamp)) + mkName :: [Text] -> Namespace mkName = intercalate "." pushItemsToQueue = forM_ itemsToSave . writeTQueue @@ -72,7 +75,7 @@ getTraceObjects :: SavedTraceObjects -> NodeId -> IO [(Namespace, TraceObjectInfo)] -getTraceObjects savedTraceObjects nodeId = atomically $ do +getTraceObjects savedTraceObjects nodeId = atomically do qForThisNode <- M.lookup nodeId <$> readTVar savedTraceObjects maybe (return []) flushTQueue qForThisNode diff --git a/cardano-tracer/src/Cardano/Tracer/Handlers/RTView/System.hs b/cardano-tracer/src/Cardano/Tracer/Handlers/System.hs similarity index 70% rename from cardano-tracer/src/Cardano/Tracer/Handlers/RTView/System.hs rename to cardano-tracer/src/Cardano/Tracer/Handlers/System.hs index 448b6280435..32024b5ba88 100644 --- a/cardano-tracer/src/Cardano/Tracer/Handlers/RTView/System.hs +++ b/cardano-tracer/src/Cardano/Tracer/Handlers/System.hs @@ -1,7 +1,7 @@ {-# LANGUAGE CPP #-} {-# LANGUAGE NamedFieldPuns #-} -module Cardano.Tracer.Handlers.RTView.System +module Cardano.Tracer.Handlers.System ( getPathToBackupDir , getPathToChartColorsDir , getPathToChartsConfig @@ -9,32 +9,13 @@ module Cardano.Tracer.Handlers.RTView.System , getPathToThemeConfig , getPathsToNotificationsSettings , getPathsToSSLCerts - , getProcessId ) where -import Data.Word (Word32) -import Graphics.UI.Threepenny.Core (UI, liftIO) import qualified System.Directory as D import System.FilePath (()) -#if defined(mingw32_HOST_OS) -import System.Win32.Process (getCurrentProcessId) -#else -import System.Posix.Process (getProcessID) -import System.Posix.Types (CPid (..)) -#endif - import Cardano.Tracer.Environment -getProcessId :: UI Word32 -getProcessId = -#if defined(mingw32_HOST_OS) - liftIO getCurrentProcessId -#else - do CPid pid <- liftIO getProcessID - return $ fromIntegral pid -#endif - getPathToChartsConfig , getPathToThemeConfig , getPathToLogsLiveViewFontConfig :: TracerEnv -> IO FilePath @@ -43,13 +24,13 @@ getPathToThemeConfig = getPathToConfig "theme" getPathToLogsLiveViewFontConfig = getPathToConfig "llvFontSize" getPathToConfig :: FilePath -> TracerEnv -> IO FilePath -getPathToConfig configName TracerEnv{teRTViewStateDir} = do - configDir <- getPathToConfigDir teRTViewStateDir +getPathToConfig configName TracerEnv{teStateDir} = do + configDir <- getPathToConfigDir teStateDir return $ configDir configName getPathsToSSLCerts :: TracerEnv -> IO (FilePath, FilePath) -getPathsToSSLCerts TracerEnv{teRTViewStateDir} = do - configDir <- getPathToConfigDir teRTViewStateDir +getPathsToSSLCerts TracerEnv{teStateDir} = do + configDir <- getPathToConfigDir teStateDir let pathToSSLSubDir = configDir "ssl" D.createDirectoryIfMissing True pathToSSLSubDir return ( pathToSSLSubDir "cert.pem" @@ -66,8 +47,8 @@ getPathsToNotificationsSettings rtvSD = do ) getPathToChartColorsDir :: TracerEnv -> IO FilePath -getPathToChartColorsDir TracerEnv{teRTViewStateDir} = do - configDir <- getPathToConfigDir teRTViewStateDir +getPathToChartColorsDir TracerEnv{teStateDir} = do + configDir <- getPathToConfigDir teStateDir let pathToColorsSubDir = configDir "color" D.createDirectoryIfMissing True pathToColorsSubDir return pathToColorsSubDir @@ -80,8 +61,8 @@ getPathToConfigDir rtvSD = do return pathToRTViewConfigDir getPathToBackupDir :: TracerEnv -> IO FilePath -getPathToBackupDir TracerEnv{teRTViewStateDir} = do - dataDir <- getStateDir teRTViewStateDir D.XdgData +getPathToBackupDir TracerEnv{teStateDir} = do + dataDir <- getStateDir teStateDir D.XdgData let pathToRTViewBackupDir = dataDir rtViewRootDir "backup" D.createDirectoryIfMissing True pathToRTViewBackupDir return pathToRTViewBackupDir diff --git a/cardano-tracer/src/Cardano/Tracer/Handlers/RTView/Update/Utils.hs b/cardano-tracer/src/Cardano/Tracer/Handlers/Utils.hs similarity index 97% rename from cardano-tracer/src/Cardano/Tracer/Handlers/RTView/Update/Utils.hs rename to cardano-tracer/src/Cardano/Tracer/Handlers/Utils.hs index 6a0852b1db7..6e9cdf5ad45 100644 --- a/cardano-tracer/src/Cardano/Tracer/Handlers/RTView/Update/Utils.hs +++ b/cardano-tracer/src/Cardano/Tracer/Handlers/Utils.hs @@ -1,7 +1,7 @@ {-# LANGUAGE LambdaCase #-} {-# LANGUAGE NumericUnderscores #-} -module Cardano.Tracer.Handlers.RTView.Update.Utils +module Cardano.Tracer.Handlers.Utils ( askDataPoint , utc2ns , utc2s @@ -41,7 +41,7 @@ askDataPoint -> NodeId -> DataPointName -> IO (Maybe a) -askDataPoint dpRequestors currentDPLock nodeId dpName = withLock currentDPLock $ do +askDataPoint dpRequestors currentDPLock nodeId dpName = withLock currentDPLock do requestors <- readTVarIO dpRequestors case M.lookup nodeId requestors of Nothing -> return Nothing diff --git a/cardano-tracer/src/Cardano/Tracer/MetaTrace.hs b/cardano-tracer/src/Cardano/Tracer/MetaTrace.hs index 57e3f198dd3..4fadf6de9da 100644 --- a/cardano-tracer/src/Cardano/Tracer/MetaTrace.hs +++ b/cardano-tracer/src/Cardano/Tracer/MetaTrace.hs @@ -34,17 +34,29 @@ import GHC.Generics import qualified System.IO as Sys data TracerTrace - = TracerParamsAre + -- | Static information about the build. + = TracerBuildInfo + { ttBuiltWithRTView :: !Bool + } + | TracerParamsAre { ttConfigPath :: !FilePath , ttStateDir :: !(Maybe FilePath) , ttMinLogSeverity :: !(Maybe SeverityS) } | TracerConfigIs - { ttConfig :: !TracerConfig } + { ttConfig :: !TracerConfig + , ttWarnRTViewMissing :: !Bool + } | TracerInitStarted | TracerInitEventQueues | TracerInitDone | TracerStartedLogRotator | TracerStartedPrometheus + { ttPrometheusEndpoint :: !Endpoint + } + | TracerStartedMonitoring + { ttMonitoringEndpoint :: !Endpoint + , ttMonitoringType :: !Text + } | TracerStartedAcceptors { ttAcceptorsAddr :: !Network } | TracerStartedRTView @@ -70,56 +82,93 @@ data TracerTrace instance ToJSON TracerTrace where toEncoding :: TracerTrace -> Encoding toEncoding = \case - TracerParamsAre{..} -> pairs - ("ConfigPath" .= ttConfigPath - <> "StateDir" .= ttStateDir - <> "MinLogSeverity" .= ttMinLogSeverity - <> "kind" .= ("TracerParamsAre" :: Text)) - TracerConfigIs{..} -> pairs - ("Config" .= ttConfig - <> "kind" .= ("TracerConfigIs" :: Text)) - TracerInitStarted -> pairs - ("kind" .= ("TracerInitStarted" :: Text)) - TracerInitEventQueues -> pairs - ("kind" .= ("TracerInitEventQueues" :: Text)) - TracerInitDone -> pairs - ("kind" .= ("TracerInitDone" :: Text)) - TracerStartedLogRotator -> pairs - ("kind" .= ("TracerStartedLogRotator" :: Text)) - TracerStartedPrometheus -> pairs - ("kind" .= ("TracerStartedPrometheus" :: Text)) - TracerStartedAcceptors{..} -> pairs - ("kind" .= ("TracerStartedAcceptors" :: Text) - <> "AcceptorsAddr" .= ttAcceptorsAddr) - TracerStartedRTView -> pairs - ("kind" .= ("TracerStartedRTView" :: Text)) - TracerStartedReforwarder -> pairs - ("kind" .= ("TracerStartedReforwarder" :: Text)) - TracerSockListen{..} -> pairs - ("kind" .= ("TracerSockListen" :: Text) - <> "ListenAt" .= ttListenAt) - TracerSockIncoming{..} -> pairs - ("kind" .= ("TracerSockIncoming" :: Text) - <> "ConnectionIncomingAt" .= ttConnectionIncomingAt - <> "Addr" .= ttAddr) - TracerSockConnecting{..} -> pairs - ("kind" .= ("TracerSockConnecting" :: Text) - <> "ConnectionIncomingAt" .= ttConnectingTo) - TracerSockConnected{..} -> pairs - ("kind" .= ("TracerSockConnected" :: Text) - <> "ConnectedTo" .= ttConnectedTo) - TracerShutdownInitiated -> pairs - ("kind" .= ("TracerShutdownInitiated" :: Text)) - TracerShutdownHistBackup -> pairs - ("kind" .= ("TracerShutdownHistBackup" :: Text)) - TracerShutdownComplete -> pairs - ("kind" .= ("TracerShutdownComplete" :: Text)) - TracerError{..} -> pairs - ("kind" .= ("TracerError" :: Text) - <> "Error" .= ttError) - TracerResource{..} -> pairs - ("kind" .= ("TracerResource" :: Text) - <> "Resource" .= ttResource) + TracerBuildInfo{..} -> concatPairs + [ "BuiltWithRTView" .= ttBuiltWithRTView + , "kind" .= txt "TracerBuildInfo" + ] + TracerParamsAre{..} -> concatPairs + [ "ConfigPath" .= ttConfigPath + , "StateDir" .= ttStateDir + , "MinLogSeverity" .= ttMinLogSeverity + , "kind" .= txt "TracerParamsAre" + ] + TracerConfigIs{..} -> concatPairs $ + [ "Config" .= ttConfig + , "kind" .= txt "TracerConfigIs" ] ++ + [ "WarnRTViewMissing" .= txt "RTView requested in config but cardano-tracer was built without it." + | ttWarnRTViewMissing + ] + TracerInitStarted -> concatPairs + [ "kind" .= txt "TracerInitStarted" + ] + TracerInitEventQueues -> concatPairs + [ "kind" .= txt "TracerInitEventQueues" + ] + TracerInitDone -> concatPairs + [ "kind" .= txt "TracerInitDone" + ] + TracerStartedLogRotator -> concatPairs + [ "kind" .= txt "TracerStartedLogRotator" + ] + TracerStartedPrometheus{..} -> concatPairs + [ "kind" .= txt "TracerStartedPrometheus" + , "endpoint" .= ttPrometheusEndpoint + ] + TracerStartedMonitoring{..} -> concatPairs + [ "kind" .= txt "TracerStartedMonitoring" + , "endpoint" .= ttMonitoringEndpoint + , "type" .= ttMonitoringType + ] + TracerStartedAcceptors{..} -> concatPairs + [ "kind" .= txt "TracerStartedAcceptors" + , "AcceptorsAddr" .= ttAcceptorsAddr + ] + TracerStartedRTView -> concatPairs + [ "kind" .= txt "TracerStartedRTView" + ] + TracerStartedReforwarder -> concatPairs + [ "kind" .= txt "TracerStartedReforwarder" + ] + TracerSockListen{..} -> concatPairs + [ "kind" .= txt "TracerSockListen" + , "ListenAt" .= ttListenAt + ] + TracerSockIncoming{..} -> concatPairs + [ "kind" .= txt "TracerSockIncoming" + , "ConnectionIncomingAt" .= ttConnectionIncomingAt + , "Addr" .= ttAddr + ] + TracerSockConnecting{..} -> concatPairs + [ "kind" .= txt "TracerSockConnecting" + , "ConnectionIncomingAt" .= ttConnectingTo + ] + TracerSockConnected{..} -> concatPairs + [ "kind" .= txt "TracerSockConnected" + , "ConnectedTo" .= ttConnectedTo + ] + TracerShutdownInitiated -> concatPairs + [ "kind" .= txt "TracerShutdownInitiated" + ] + TracerShutdownHistBackup -> concatPairs + [ "kind" .= txt "TracerShutdownHistBackup" + ] + TracerShutdownComplete -> concatPairs + [ "kind" .= txt "TracerShutdownComplete" + ] + TracerError{..} -> concatPairs + [ "kind" .= txt "TracerError" + , "Error" .= ttError + ] + TracerResource{..} -> concatPairs + [ "kind" .= txt "TracerResource" + , "Resource" .= ttResource + ] + where + txt :: Text -> Text + txt = id + concatPairs :: [Series] -> Encoding + concatPairs = pairs . mconcat + toJSON = AE.genericToJSON jsonEncodingOptions jsonEncodingOptions :: AE.Options @@ -134,7 +183,13 @@ jsonEncodingOptions = AE.defaultOptions } instance LogFormatting TracerTrace where - forHuman = T.pack . show + forHuman t@TracerConfigIs{ttWarnRTViewMissing = True} = T.pack $ + unlines + [ show t ++ ": RTView requested in config but cardano-tracer was built without it." + , "Enable with `-f +rtview`." + ] + forHuman t = T.pack (show t) + forMachine DMinimal _ = mempty forMachine DNormal _ = mempty forMachine DDetailed t = forMachine DMaximum t @@ -143,13 +198,15 @@ instance LogFormatting TracerTrace where _ -> error "Impossible" instance MetaTrace TracerTrace where + namespaceFor TracerBuildInfo {} = Namespace [] ["BuildInfo"] namespaceFor TracerParamsAre {} = Namespace [] ["ParamsAre"] namespaceFor TracerConfigIs {} = Namespace [] ["ConfigIs"] namespaceFor TracerInitStarted = Namespace [] ["InitStart"] namespaceFor TracerInitEventQueues = Namespace [] ["EventQueues"] namespaceFor TracerInitDone = Namespace [] ["InitDone"] namespaceFor TracerStartedLogRotator = Namespace [] ["StartedLogRotator"] - namespaceFor TracerStartedPrometheus = Namespace [] ["StartedPrometheus"] + namespaceFor TracerStartedPrometheus{} = Namespace [] ["StartedPrometheus"] + namespaceFor TracerStartedMonitoring{} = Namespace [] ["StartedMonitoring"] namespaceFor TracerStartedAcceptors {} = Namespace [] ["StartedAcceptors"] namespaceFor TracerStartedRTView = Namespace [] ["StartedRTView"] namespaceFor TracerStartedReforwarder = Namespace [] ["StartedReforwarder"] @@ -170,6 +227,7 @@ instance MetaTrace TracerTrace where severityFor (Namespace _ ["InitDone"]) _ = Just Info severityFor (Namespace _ ["StartedLogRotator"]) _ = Just Info severityFor (Namespace _ ["StartedPrometheus"]) _ = Just Info + severityFor (Namespace _ ["StartedMonitoring"]) _ = Just Info severityFor (Namespace _ ["StartedAcceptors"]) _ = Just Info severityFor (Namespace _ ["StartedRTView"]) _ = Just Info severityFor (Namespace _ ["StartedReforwarder"]) _ = Just Info @@ -194,6 +252,7 @@ instance MetaTrace TracerTrace where , Namespace [] ["InitDone"] , Namespace [] ["StartedLogRotator"] , Namespace [] ["StartedPrometheus"] + , Namespace [] ["StartedMonitoring"] , Namespace [] ["StartedAcceptors"] , Namespace [] ["StartedRTView"] , Namespace [] ["StartedReforwarder"] diff --git a/cardano-tracer/src/Cardano/Tracer/Run.hs b/cardano-tracer/src/Cardano/Tracer/Run.hs index cc07e435731..ddd1d03edc8 100644 --- a/cardano-tracer/src/Cardano/Tracer/Run.hs +++ b/cardano-tracer/src/Cardano/Tracer/Run.hs @@ -17,9 +17,11 @@ import Cardano.Tracer.Environment import Cardano.Tracer.Handlers.Logs.Rotator import Cardano.Tracer.Handlers.Metrics.Servers import Cardano.Tracer.Handlers.ReForwarder -import Cardano.Tracer.Handlers.RTView.Run +#if RTVIEW import Cardano.Tracer.Handlers.RTView.State.Historical import Cardano.Tracer.Handlers.RTView.Update.Historical +import Cardano.Tracer.Handlers.RTView.Run +#endif import Cardano.Tracer.MetaTrace import Cardano.Tracer.Types import Cardano.Tracer.Utils @@ -28,18 +30,41 @@ import Control.Concurrent (threadDelay) import Control.Concurrent.Async (async, link) import Control.Concurrent.Async.Extra (sequenceConcurrently) import Control.Concurrent.Extra (newLock) +#if RTVIEW import Control.Concurrent.STM.TVar (newTVarIO) +#endif import Control.Monad import Data.Foldable (for_) +#if !RTVIEW +import Data.Maybe (isJust) +#endif -- | Top-level run function, called by 'cardano-tracer' app. runCardanoTracer :: TracerParams -> IO () runCardanoTracer TracerParams{tracerConfig, stateDir, logSeverity} = do tr <- mkTracerTracer $ SeverityF logSeverity - traceWith tr $ TracerParamsAre tracerConfig stateDir logSeverity + traceWith tr TracerBuildInfo +#if RTVIEW + { ttBuiltWithRTView = True +#else + { ttBuiltWithRTView = False +#endif + } + traceWith tr TracerParamsAre + { ttConfigPath = tracerConfig + , ttStateDir = stateDir + , ttMinLogSeverity = logSeverity + } config <- readTracerConfig tracerConfig - traceWith tr $ TracerConfigIs config + traceWith tr TracerConfigIs + { ttConfig = config +#if RTVIEW + , ttWarnRTViewMissing = False +#else + , ttWarnRTViewMissing = isJust (hasRTView config) +#endif + } for_ (resourceFreq config) \msInterval -> do threadId <- async do @@ -67,51 +92,63 @@ doRunCardanoTracer config rtViewStateDir tr protocolsBrake dpRequestors = do connectedNodes <- initConnectedNodes connectedNodesNames <- initConnectedNodesNames acceptedMetrics <- initAcceptedMetrics +#if RTVIEW savedTO <- initSavedTraceObjects chainHistory <- initBlockchainHistory resourcesHistory <- initResourcesHistory txHistory <- initTransactionsHistory +#endif currentLogLock <- newLock currentDPLock <- newLock traceWith tr TracerInitEventQueues +#if RTVIEW eventsQueues <- initEventsQueues rtViewStateDir connectedNodesNames dpRequestors currentDPLock rtViewPageOpened <- newTVarIO False +#endif (reforwardTraceObject,_trDataPoint) <- initReForwarder config tr registry <- newRegistry -- Environment for all following functions. - let tracerEnv = - TracerEnv - { teConfig = config - , teConnectedNodes = connectedNodes - , teConnectedNodesNames = connectedNodesNames - , teAcceptedMetrics = acceptedMetrics - , teSavedTO = savedTO - , teBlockchainHistory = chainHistory - , teResourcesHistory = resourcesHistory - , teTxHistory = txHistory - , teCurrentLogLock = currentLogLock - , teCurrentDPLock = currentDPLock - , teEventsQueues = eventsQueues - , teDPRequestors = dpRequestors - , teProtocolsBrake = protocolsBrake - , teRTViewPageOpened = rtViewPageOpened - , teRTViewStateDir = rtViewStateDir - , teTracer = tr - , teReforwardTraceObjects = reforwardTraceObject - , teRegistry = registry - } + let tracerEnv :: TracerEnv + tracerEnv = TracerEnv + { teConfig = config + , teConnectedNodes = connectedNodes + , teConnectedNodesNames = connectedNodesNames + , teAcceptedMetrics = acceptedMetrics + , teCurrentLogLock = currentLogLock + , teCurrentDPLock = currentDPLock + , teDPRequestors = dpRequestors + , teProtocolsBrake = protocolsBrake + , teTracer = tr + , teReforwardTraceObjects = reforwardTraceObject + , teRegistry = registry + , teStateDir = rtViewStateDir + } + + tracerEnvRTView :: TracerEnvRTView + tracerEnvRTView = TracerEnvRTView +#if RTVIEW + { teSavedTO = savedTO + , teBlockchainHistory = chainHistory + , teResourcesHistory = resourcesHistory + , teTxHistory = txHistory + , teEventsQueues = eventsQueues + , teRTViewPageOpened = rtViewPageOpened + } +#endif -- Specify what should be done before 'cardano-tracer' stops. beforeProgramStops $ do traceWith tr TracerShutdownInitiated - backupAllHistory tracerEnv +#if RTVIEW + backupAllHistory tracerEnv tracerEnvRTView +#endif traceWith tr TracerShutdownHistBackup applyBrake (teProtocolsBrake tracerEnv) traceWith tr TracerShutdownComplete @@ -120,6 +157,8 @@ doRunCardanoTracer config rtViewStateDir tr protocolsBrake dpRequestors = do void . sequenceConcurrently $ [ runLogsRotator tracerEnv , runMetricsServers tracerEnv - , runAcceptors tracerEnv - , runRTView tracerEnv + , runAcceptors tracerEnv tracerEnvRTView +#if RTVIEW + , runRTView tracerEnv tracerEnvRTView +#endif ] diff --git a/cardano-tracer/src/Cardano/Tracer/Utils.hs b/cardano-tracer/src/Cardano/Tracer/Utils.hs index 1039b9b744d..72ea2d34588 100644 --- a/cardano-tracer/src/Cardano/Tracer/Utils.hs +++ b/cardano-tracer/src/Cardano/Tracer/Utils.hs @@ -1,5 +1,4 @@ {-# LANGUAGE BangPatterns #-} -{-# LANGUAGE CPP #-} {-# LANGUAGE LambdaCase #-} {-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE OverloadedStrings #-} @@ -22,6 +21,7 @@ module Cardano.Tracer.Utils , initConnectedNodesNames , initDataPointRequestors , initProtocolsBrake + , logTrace , lift2M , lift3M , forMM @@ -37,12 +37,13 @@ module Cardano.Tracer.Utils , clearRegistry , modifyRegistry_ , readRegistry + , getProcessId ) where import Cardano.Node.Startup (NodeInfo (..)) import Cardano.Tracer.Configuration import Cardano.Tracer.Environment -import Cardano.Tracer.Handlers.RTView.Update.Utils +import Cardano.Tracer.Handlers.Utils import Cardano.Tracer.Types import Ouroboros.Network.Socket (ConnectionId (..)) @@ -54,17 +55,18 @@ import Control.Applicative (liftA2, liftA3) #endif import Control.Concurrent (killThread, mkWeakThreadId, myThreadId) import Control.Concurrent.Extra (Lock) -import Control.Concurrent.MVar (newMVar, putMVar, readMVar, tryReadMVar, modifyMVar_) +import Control.Concurrent.MVar (newMVar, swapMVar, readMVar, tryReadMVar, modifyMVar_) import Control.Concurrent.STM (atomically) import Control.Concurrent.STM.TVar (modifyTVar', newTVarIO, readTVarIO) import Control.Exception (SomeAsyncException (..), SomeException, finally, fromException, try, tryJust) import Control.Monad (forM_) import Control.Monad.Extra (whenJustM) -import "contra-tracer" Control.Tracer (showTracing, stdoutTracer, traceWith) +import "contra-tracer" Control.Tracer (stdoutTracer, traceWith) +import Data.Word (Word32) import qualified Data.Bimap as BM import Data.Foldable (traverse_) -import Data.Functor ((<&>)) +import Data.Functor ((<&>), void) import Data.List.Extra (dropPrefix, dropSuffix, replace) import qualified Data.Map.Strict as Map import qualified Data.Set as S @@ -75,6 +77,13 @@ import System.Mem.Weak (deRefWeak) import qualified System.Signal as S import System.Time.Extra (sleep) +#if defined(mingw32_HOST_OS) +import System.Win32.Process (getCurrentProcessId) +#else +import System.Posix.Process (getProcessID) +import System.Posix.Types (CPid (..)) +#endif + -- | Run monadic action in a loop. If there's an exception, -- it will re-run the action again, after pause that grows. runInLoop @@ -116,7 +125,7 @@ showProblemIfAny verb action = Right _ -> return () logTrace :: String -> IO () -logTrace = traceWith $ showTracing stdoutTracer +logTrace = traceWith stdoutTracer connIdToNodeId :: Show addr => ConnectionId addr -> NodeId connIdToNodeId ConnectionId{remoteAddress} = NodeId preparedAddress @@ -259,10 +268,20 @@ elemsRegistry (Registry registry) = do clearRegistry :: HandleRegistry -> IO () clearRegistry registry@(Registry mvar) = do elemsRegistry registry >>= traverse_ (hClose . fst) - putMVar mvar Map.empty + void do + swapMVar mvar Map.empty modifyRegistry_ :: Registry a b -> (Map.Map a b -> IO (Map.Map a b)) -> IO () modifyRegistry_ (Registry registry) = modifyMVar_ registry readRegistry :: Registry a b -> IO (Map.Map a b) readRegistry (Registry registry) = readMVar registry + +getProcessId :: IO Word32 +getProcessId = +#if defined(mingw32_HOST_OS) + getCurrentProcessId +#else + do CPid pid <- getProcessID + return $ fromIntegral pid +#endif diff --git a/cardano-tracer/test/Cardano/Tracer/Test/Acceptor.hs b/cardano-tracer/test/Cardano/Tracer/Test/Acceptor.hs index d6c5132ea33..6b8f34a097c 100644 --- a/cardano-tracer/test/Cardano/Tracer/Test/Acceptor.hs +++ b/cardano-tracer/test/Cardano/Tracer/Test/Acceptor.hs @@ -9,15 +9,21 @@ module Cardano.Tracer.Test.Acceptor import Cardano.Tracer.Acceptors.Run import Cardano.Tracer.Configuration import Cardano.Tracer.Environment +#if RTVIEW import Cardano.Tracer.Handlers.RTView.Run import Cardano.Tracer.Handlers.RTView.State.Historical +#endif import Cardano.Tracer.MetaTrace import Cardano.Tracer.Types import Cardano.Tracer.Utils import Control.Concurrent.Async.Extra (sequenceConcurrently) import Control.Concurrent.Extra (newLock) +#if RTVIEW import Control.Concurrent.STM.TVar (newTVarIO, readTVarIO) +#else +import Control.Concurrent.STM.TVar (readTVarIO) +#endif import Control.Monad (forM_, forever, void) import qualified Data.ByteString.Lazy as LBS import qualified Data.List.NonEmpty as NE @@ -40,9 +46,12 @@ launchAcceptorsSimple mode localSock dpName = do connectedNodes <- initConnectedNodes connectedNodesNames <- initConnectedNodesNames acceptedMetrics <- initAcceptedMetrics +#if RTVIEW savedTO <- initSavedTraceObjects +#endif currentLogLock <- newLock currentDPLock <- newLock +#if RTVIEW eventsQueues <- initEventsQueues Nothing connectedNodesNames dpRequestors currentDPLock chainHistory <- initBlockchainHistory @@ -50,35 +59,42 @@ launchAcceptorsSimple mode localSock dpName = do txHistory <- initTransactionsHistory rtViewPageOpened <- newTVarIO False +#endif tr <- mkTracerTracer $ SeverityF $ Just Warning registry <- newRegistry - let tracerEnv = - TracerEnv - { teConfig = mkConfig - , teConnectedNodes = connectedNodes - , teConnectedNodesNames = connectedNodesNames - , teAcceptedMetrics = acceptedMetrics - , teSavedTO = savedTO - , teBlockchainHistory = chainHistory - , teResourcesHistory = resourcesHistory - , teTxHistory = txHistory - , teCurrentLogLock = currentLogLock - , teCurrentDPLock = currentDPLock - , teEventsQueues = eventsQueues - , teDPRequestors = dpRequestors - , teProtocolsBrake = protocolsBrake - , teRTViewPageOpened = rtViewPageOpened - , teRTViewStateDir = Nothing - , teTracer = tr - , teReforwardTraceObjects = \_-> pure () - , teRegistry = registry - } + let tracerEnv :: TracerEnv + tracerEnv = TracerEnv + { teConfig = mkConfig + , teConnectedNodes = connectedNodes + , teConnectedNodesNames = connectedNodesNames + , teAcceptedMetrics = acceptedMetrics + , teCurrentLogLock = currentLogLock + , teCurrentDPLock = currentDPLock + , teDPRequestors = dpRequestors + , teProtocolsBrake = protocolsBrake + , teTracer = tr + , teReforwardTraceObjects = \_-> pure () + , teRegistry = registry + , teStateDir = Nothing + } + + tracerEnvRTView :: TracerEnvRTView + tracerEnvRTView = TracerEnvRTView +#if RTVIEW + { teSavedTO = savedTO + , teBlockchainHistory = chainHistory + , teResourcesHistory = resourcesHistory + , teTxHistory = txHistory + , teEventsQueues = eventsQueues + , teRTViewPageOpened = rtViewPageOpened + } +#endif -- NOTE: no reforwarding in this acceptor. void . sequenceConcurrently $ - [ runAcceptors tracerEnv + [ runAcceptors tracerEnv tracerEnvRTView , runDataPointsPrinter dpName dpRequestors ] where