Add Node's party identifier in logs

input-output-hk · Jun 16, 2021 · 4b7202e · 4b7202e
1 parent ce06ac6
commit 4b7202e
Show file tree

Hide file tree

Showing 3 changed files with 17 additions and 17 deletions.
diff --git a/hydra-node/src/Hydra/Logging/Monitoring.hs b/hydra-node/src/Hydra/Logging/Monitoring.hs
@@ -41,7 +41,7 @@ withMonitoring (Just monitoringPort) (Tracer tracer) action = do
 prepareRegistry :: MonadIO m => m (HydraLog tx net -> m (), Registry)
 prepareRegistry = first monitor <$> registerMetrics
  where
-  monitor metricsMap (Node (ProcessedEvent _)) =
+  monitor metricsMap (Node (ProcessedEvent _ _)) =
     case Map.lookup "hydra_head_events" metricsMap of
       (Just (CounterMetric c)) -> liftIO $ inc c
       _ -> pure ()

diff --git a/hydra-node/src/Hydra/Node.hs b/hydra-node/src/Hydra/Node.hs
@@ -39,11 +39,11 @@ data HydraNode tx m = HydraNode
   }
 
 data HydraNodeLog tx
-  = ErrorHandlingEvent (Event tx) (LogicError tx)
-  | ProcessingEvent (Event tx)
-  | ProcessedEvent (Event tx)
-  | ProcessingEffect (Effect tx)
-  | ProcessedEffect (Effect tx)
+  = ErrorHandlingEvent Party (Event tx) (LogicError tx)
+  | ProcessingEvent Party (Event tx)
+  | ProcessedEvent Party (Event tx)
+  | ProcessingEffect Party (Effect tx)
+  | ProcessedEffect Party (Effect tx)
   deriving (Eq, Show)
 
 handleClientRequest :: HydraNode tx m -> ClientRequest tx -> m ()
@@ -65,15 +65,15 @@ runHydraNode ::
   Tracer m (HydraNodeLog tx) ->
   HydraNode tx m ->
   m ()
-runHydraNode tracer node@HydraNode{eq} = do
+runHydraNode tracer node@HydraNode{eq, env = Environment{party}} = do
   -- NOTE(SN): here we could introduce concurrent head processing, e.g. with
   -- something like 'forM_ [0..1] $ async'
   forever $ do
     e <- nextEvent eq
-    traceWith tracer $ ProcessingEvent e
+    traceWith tracer $ ProcessingEvent party e
     processNextEvent node e >>= \case
-      Left err -> traceWith tracer (ErrorHandlingEvent e err) >> throwIO err
-      Right effs -> forM_ effs (processEffect node tracer) >> traceWith tracer (ProcessedEvent e)
+      Left err -> traceWith tracer (ErrorHandlingEvent party e err) >> throwIO err
+      Right effs -> forM_ effs (processEffect node tracer) >> traceWith tracer (ProcessedEvent party e)
 
 -- | Monadic interface around 'Hydra.Logic.update'.
 processNextEvent ::
@@ -101,14 +101,14 @@ processEffect ::
   Tracer m (HydraNodeLog tx) ->
   Effect tx ->
   m ()
-processEffect HydraNode{hn, oc, sendResponse, eq} tracer e = do
-  traceWith tracer $ ProcessingEffect e
+processEffect HydraNode{hn, oc, sendResponse, eq, env = Environment{party}} tracer e = do
+  traceWith tracer $ ProcessingEffect party e
   case e of
     ClientEffect i -> sendResponse i
     NetworkEffect msg -> broadcast hn msg
     OnChainEffect tx -> postTx oc tx
     Delay after event -> void . async $ threadDelay after >> putEvent eq event
-  traceWith tracer $ ProcessedEffect e
+  traceWith tracer $ ProcessedEffect party e
 -- ** Some general event queue from which the Hydra head is "fed"
 
 -- | The single, required queue in the system from which a hydra head is "fed".

diff --git a/hydra-node/test/Hydra/BehaviorSpec.hs b/hydra-node/test/Hydra/BehaviorSpec.hs
@@ -202,8 +202,8 @@ spec = describe "Behavior of one ore more hydra-nodes" $ do
 
           logs = selectTraceEventsDynamic @_ @(HydraNodeLog MockTx) result
 
-      logs `shouldContain` [ProcessingEvent (ClientEvent $ Init [1])]
-      logs `shouldContain` [ProcessedEvent (ClientEvent $ Init [1])]
+      logs `shouldContain` [ProcessingEvent 1 (ClientEvent $ Init [1])]
+      logs `shouldContain` [ProcessedEvent 1 (ClientEvent $ Init [1])]
 
     it "traces handling of effects" $ do
       let result = runSimTrace $ do
@@ -214,8 +214,8 @@ spec = describe "Behavior of one ore more hydra-nodes" $ do
 
           logs = selectTraceEventsDynamic @_ @(HydraNodeLog MockTx) result
 
-      logs `shouldContain` [ProcessingEffect (ClientEffect ReadyToCommit)]
-      logs `shouldContain` [ProcessedEffect (ClientEffect ReadyToCommit)]
+      logs `shouldContain` [ProcessingEffect 1 (ClientEffect ReadyToCommit)]
+      logs `shouldContain` [ProcessedEffect 1 (ClientEffect ReadyToCommit)]
 
 sendRequestAndWaitFor ::
   ( HasCallStack