Reverse Dependency: trace-dispatcher no longer depends on trace-forward

bench/tx-generator/src/Cardano/Benchmarking/Tracer.hs

@@ -49,8 +49,8 @@ import qualified Data.Text as Text
 import           Data.Time.Clock
 import           GHC.Generics
 
-import           Trace.Forward.Utils.DataPoint
 import           Trace.Forward.Utils.TraceObject
+import Trace.Forward.Forwarding (initForwardingDelayed)
 
 pattern TracerNameBench     :: Text
 pattern TracerNameBench     = "Benchmark"
@@ -121,7 +121,7 @@ initTxGenTracers mbForwarding = do
   prepareForwardingTracer = forM mbForwarding $
     \(iomgr, networkId, tracerSocket) -> do
         let forwardingConf = fromMaybe defaultForwarder (tcForwarder initialTraceConfig)
-        (forwardSink :: ForwardSink TraceObject, dpStore, kickoffForwarder) <-
+        (forwardSink, dpStore, kickoffForwarder) <-
             initForwardingDelayed iomgr forwardingConf (toNetworkMagic networkId) Nothing $ Just (Net.LocalPipe tracerSocket, Initiator)
 
         -- we need to provide NodeInfo DataPoint, to forward generator's name
@@ -134,7 +134,7 @@ initTxGenTracers mbForwarding = do
         traceWith nodeInfoTracer genInfo
 
         kickoffForwarder
-        pure $ forwardTracer forwardSink
+        pure $ forwardTracer (writeToSink forwardSink)
 
   prepareGenInfo :: IO NodeInfo
   prepareGenInfo =

cardano-node/cardano-node.cabal

@@ -211,8 +211,8 @@ library
                       , sop-extras
                       , text >= 2.0
                       , time
-                      , trace-dispatcher ^>= 2.9.2
-                      , trace-forward ^>= 2.2.11
+                      , trace-dispatcher ^>= 2.10.0
+                      , trace-forward ^>= 2.3.0
                       , trace-resources ^>= 0.2.3
                       , tracer-transformers
                       , transformers

cardano-node/src/Cardano/Node/Tracing/API.hs

@@ -51,6 +51,8 @@ import           Data.Time.Clock (getCurrentTime)
 import           Network.Mux.Trace (TraceLabelPeer (..))
 import           Network.Socket (HostName)
 import           System.Metrics as EKG
+import Trace.Forward.Forwarding (initForwardingDelayed)
+import Trace.Forward.Utils.TraceObject (writeToSink)
 
 
 initTraceDispatcher ::
@@ -130,7 +132,7 @@ initTraceDispatcher nc p networkMagic nodeKernel p2pMode noBlockForging = do
                 forwardingConf :: TraceOptionForwarder
                 forwardingConf = fromMaybe defaultForwarder (tcForwarder trConfig)
             initForwardingDelayed iomgr forwardingConf networkMagic (Just ekgStore) tracerSocketMode
-          pure (forwardTracer forwardSink, dataPointTracer dpStore, kickoffForwarder)
+          pure (forwardTracer (writeToSink forwardSink), dataPointTracer dpStore, kickoffForwarder)
         else
           -- Since 'Forwarder' backend isn't enabled, there is no forwarding.
           -- So we use nullTracers to ignore 'TraceObject's and 'DataPoint's.

cardano-node/src/Cardano/Node/Tracing/Tracers.hs

@@ -73,8 +73,6 @@ import           Data.Proxy (Proxy (..))
 import           Network.Mux.Trace (TraceLabelPeer (..))
 import           Network.Socket (SockAddr)
 
-import           Trace.Forward.Utils.DataPoint (DataPoint)
-
 -- | Construct tracers for all system components.
 --
 mkDispatchTracers

cardano-tracer/cardano-tracer.cabal

@@ -197,8 +197,8 @@ library
                       , string-qq
                       , text
                       , time
-                      , trace-dispatcher ^>= 2.9.2
-                      , trace-forward ^>= 2.2.11
+                      , trace-dispatcher ^>= 2.10.0
+                      , trace-forward ^>= 2.3.0
                       , trace-resources ^>= 0.2.3
                       , wai ^>= 3.2
                       , warp ^>= 3.4

cardano-tracer/src/Cardano/Tracer/Handlers/ReForwarder.hs

@@ -15,7 +15,7 @@ module Cardano.Tracer.Handlers.ReForwarder
   ( initReForwarder
   ) where
 
-import           Cardano.Logging.Forwarding
+import           Trace.Forward.Forwarding
 import           Cardano.Logging.Trace
 import           Cardano.Logging.Tracer.DataPoint
 import qualified Cardano.Logging.Types as Log
@@ -29,8 +29,8 @@ import           Control.Monad (when)
 import           Data.List (isPrefixOf)
 import qualified Data.Text as Text
 
-import           Trace.Forward.Utils.DataPoint
-import           Trace.Forward.Utils.TraceObject (ForwardSink, writeToSink)
+import           Trace.Forward.Utils.TraceObject (writeToSink)
+import Trace.Forward.Utils.ForwardSink (ForwardSink)
 
 -- | Initialize the reforwarding service if configured to be active.
 --   Returns

cardano-tracer/test/Cardano/Tracer/Test/Forwarder.hs

@@ -71,6 +71,7 @@ import           Trace.Forward.Run.DataPoint.Forwarder
 import           Trace.Forward.Run.TraceObject.Forwarder
 import           Trace.Forward.Utils.DataPoint
 import           Trace.Forward.Utils.TraceObject
+import Trace.Forward.Utils.ForwardSink (ForwardSink)
 
 data ForwardersMode = Initiator | Responder
 

cardano-tracer/test/cardano-tracer-test-ext.hs

@@ -29,6 +29,8 @@ import qualified System.Process as Sys
 
 import           Test.Tasty
 import           Test.Tasty.QuickCheck
+import Trace.Forward.Forwarding (initForwarding)
+import Trace.Forward.Utils.TraceObject (writeToSink)
 
 main :: IO ()
 main = do
@@ -137,4 +139,4 @@ getExternalTracerState TestSetup{..} ref = do
        let tracerSocketMode = Just (Net.LocalPipe (unI tsSockExternal), Initiator)
            forwardingConf = fromMaybe defaultForwarder (tcForwarder simpleTestConfig)
        initForwarding iomgr forwardingConf (unI tsNetworkMagic) Nothing tracerSocketMode
-     pure (externalTracerHdl, forwardTracer forwardSink)
+     pure (externalTracerHdl, forwardTracer (writeToSink forwardSink))

trace-dispatcher/src/Cardano/Logging.hs

@@ -7,7 +7,6 @@ import           Cardano.Logging.ConfigurationParser as X
 import           Cardano.Logging.Consistency as X
 import           Cardano.Logging.DocuGenerator as X
 import           Cardano.Logging.Formatter as X
-import           Cardano.Logging.Forwarding as X
 import           Cardano.Logging.FrequencyLimiter as X
 import           Cardano.Logging.Trace as X
 import           Cardano.Logging.TraceDispatcherMessage as X

trace-dispatcher/src/Cardano/Logging/DocuGenerator.hs

@@ -45,8 +45,6 @@ import           Data.Text.Lazy (toStrict)
 import           Data.Text.Lazy.Builder (Builder, fromString, fromText, singleton)
 import           Data.Time (getZonedTime)
 
-import           Trace.Forward.Utils.DataPoint (DataPoint (..))
-
 type InconsistencyWarning = Text
 
 utf16CircledT :: Text
@@ -351,7 +349,7 @@ docTracer backendConfig = Trace $ TR.arrow $ TR.emit output
 
 docTracerDatapoint :: MonadIO m =>
      BackendConfig
-  -> Trace m DataPoint
+  -> Trace m a
 docTracerDatapoint backendConfig = Trace $ TR.arrow $ TR.emit output
   where
     output p@(_, Left TCDocument {}) =

trace-dispatcher/src/Cardano/Logging/Tracer/DataPoint.hs

@@ -1,27 +1,64 @@
 {-# LANGUAGE DataKinds #-}
 {-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE GADTs #-}
 {-# LANGUAGE RecordWildCards #-}
 {-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE GADTs #-}
 
 module Cardano.Logging.Tracer.DataPoint
   (
-    dataPointTracer
+    DataPoint (..)
+  , DataPointName
+  , DataPointStore
+  , initDataPointStore
+  , writeToStore
+  , dataPointTracer
   , mkDataPointTracer
   ) where
 
 import           Cardano.Logging.DocuGenerator
 import           Cardano.Logging.Trace
 import           Cardano.Logging.Types
 
-import           Control.DeepSeq (NFData)
+import           Control.Concurrent.STM (atomically)
+import           Control.Concurrent.STM.TVar
+import           Control.DeepSeq (NFData, deepseq)
 import           Control.Monad.IO.Class
 import qualified Control.Tracer as NT
-import           Data.Aeson.Types (ToJSON)
+import           Data.Aeson
+import qualified Data.Map.Strict as M
 import           Data.Text (Text, intercalate)
 
-import           Trace.Forward.Utils.DataPoint (DataPoint (..), DataPointStore, writeToStore)
-
 ---------------------------------------------------------------------------
+--
+-- | Type wrapper for some value of type 'v'. The only reason we need this
+--   wrapper is an ability to store different values in the same 'DataPointStore'.
+--
+--   Please note that when the acceptor application will read the value of type 'v'
+--   from the store, this value is just as unstructured JSON, but not Haskell
+--   value of type 'v'. That's why 'FromJSON' instance for type 'v' should be
+--   available for the acceptor application, to decode unstructured JSON.
+--
+data DataPoint where
+  DataPoint :: (ToJSON v, NFData v) => v -> DataPoint
+
+type DataPointName   = Text
+type DataPointStore = TVar (M.Map DataPointName DataPoint)
+
+initDataPointStore :: IO DataPointStore
+initDataPointStore = newTVarIO M.empty
+
+-- | Write 'DataPoint' to the store.
+writeToStore
+  :: DataPointStore
+  -> DataPointName
+  -> DataPoint
+  -> IO ()
+writeToStore dpStore dpName (DataPoint obj) = atomically $
+  modifyTVar' dpStore $ \store ->
+    if dpName `M.member` store
+      then M.adjust (const (DataPoint (deepseq obj obj))) dpName store
+      else M.insert dpName (DataPoint (deepseq obj obj)) store
 
 dataPointTracer :: forall m. MonadIO m
   => DataPointStore

trace-dispatcher/src/Cardano/Logging/Tracer/Forward.hs

@@ -13,29 +13,26 @@ import           Cardano.Logging.Types
 import           Control.Monad.IO.Class
 import qualified Control.Tracer as T
 
-import           Trace.Forward.Utils.TraceObject (ForwardSink, writeToSink)
-
 
 ---------------------------------------------------------------------------
 
 -- | It is mandatory to construct only one forwardTracer tracer in any application!
 -- Throwing away a forwardTracer tracer and using a new one will result in an exception
 forwardTracer :: forall m. (MonadIO m)
-  => ForwardSink TraceObject
+  => (TraceObject -> IO ())
   -> Trace m FormattedMessage
-forwardTracer forwardSink =
-  Trace $ T.arrow $ T.emit $ uncurry (output forwardSink)
+forwardTracer write =
+  Trace $ T.arrow $ T.emit $ uncurry output
  where
   output ::
-       ForwardSink TraceObject
-    -> LoggingContext
+       LoggingContext
     -> Either TraceControl FormattedMessage
     -> m ()
-  output sink LoggingContext {} (Right (FormattedForwarder lo)) = liftIO $
-    writeToSink sink lo
-  output _sink LoggingContext {} (Left TCReset) = liftIO $ do
+  output LoggingContext {} (Right (FormattedForwarder lo)) = liftIO $
+    write lo
+  output LoggingContext {} (Left TCReset) = liftIO $ do
     pure ()
-  output _sink lk (Left c@TCDocument {}) =
+  output lk (Left c@TCDocument {}) =
     docIt Forwarder (lk, Left c)
-  output _sink LoggingContext {} (Right _)  = pure ()
-  output _sink LoggingContext {} _  = pure ()
+  output LoggingContext {} (Right _)  = pure ()
+  output LoggingContext {} _  = pure ()

trace-dispatcher/src/Cardano/Logging/Types.hs

@@ -59,7 +59,7 @@ module Cardano.Logging.Types (
 ) where
 
 
-import           Ouroboros.Network.Util.ShowProxy (ShowProxy (..))
+-- import           Ouroboros.Network.Util.ShowProxy (ShowProxy (..))
 
 import           Codec.Serialise (Serialise (..))
 import qualified Control.Tracer as T
@@ -386,7 +386,7 @@ data TraceObject = TraceObject {
     (Eq, Show, Generic)
   -- ^ Instances for 'TraceObject' to forward it using 'trace-forward' library.
   deriving anyclass
-    (Serialise, ShowProxy)
+    (Serialise)
 
 -- |
 data BackendConfig =

trace-dispatcher/test/Cardano/Logging/Test/Unit/DataPoint.hs

@@ -20,9 +20,6 @@ import qualified Data.Map.Strict as M
 import           GHC.Conc
 import           GHC.Generics (Generic)
 
-import           Trace.Forward.Protocol.DataPoint.Type (DataPointName)
-import           Trace.Forward.Utils.DataPoint (DataPoint (..))
-
 
 data BaseStats = BaseStats {
     bsMeasure :: Double,