Add peer to TraceKeepAliveClient

IntersectMBO · Jul 1, 2020 · 22609f2 · 22609f2
1 parent 203d7b5
commit 22609f2
Show file tree

Hide file tree

Showing 2 changed files with 8 additions and 6 deletions.
diff --git a/ouroboros-consensus/src/Ouroboros/Consensus/Node/Tracers.hs b/ouroboros-consensus/src/Ouroboros/Consensus/Node/Tracers.hs
@@ -60,7 +60,7 @@ data Tracers' remotePeer localPeer blk f = Tracers
   , mempoolTracer                 :: f (TraceEventMempool blk)
   , forgeTracer                   :: f (TraceForgeEvent blk)
   , blockchainTimeTracer          :: f  TraceBlockchainTimeEvent
-  , keepAliveClientTracer         :: f TraceKeepAliveClient
+  , keepAliveClientTracer         :: f (TraceKeepAliveClient remotePeer)
 
     -- | Called on every slot with the possibly updated 'ForgeState'
     --

diff --git a/ouroboros-network/src/Ouroboros/Network/KeepAlive.hs b/ouroboros-network/src/Ouroboros/Network/KeepAlive.hs
@@ -28,9 +28,11 @@ import           Ouroboros.Network.Protocol.KeepAlive.Server
 
 newtype KeepAliveInterval = KeepAliveInterval { keepAliveInterval :: DiffTime }
 
-data TraceKeepAliveClient =
-    AddSample DiffTime
-    deriving Show
+data TraceKeepAliveClient peer =
+    AddSample peer DiffTime
+
+instance Show peer => Show (TraceKeepAliveClient peer) where
+    show (AddSample peer rtt) = "AddSample " ++ show peer ++ show rtt
 
 keepAliveClient
     :: forall m peer.
@@ -39,7 +41,7 @@ keepAliveClient
        , MonadTimer m
        , Ord peer
        )
-    => Tracer m TraceKeepAliveClient
+    => Tracer m (TraceKeepAliveClient peer)
     -> peer
     -> (StrictTVar m (M.Map peer PeerGSV))
     -> KeepAliveInterval
@@ -60,7 +62,7 @@ keepAliveClient tracer peer dqCtx KeepAliveInterval { keepAliveInterval } startT
       startTime_m <- atomically $ readTVar startTimeV
       case startTime_m of
            Just startTime -> do
-               traceWith tracer $ AddSample $ diffTime endTime startTime
+               traceWith tracer $ AddSample peer $ diffTime endTime startTime
                let sample = fromSample startTime endTime payloadSize
                atomically $ modifyTVar dqCtx $ \m ->
                    assert (peer `M.member` m) $