From 57b480a454fd679f2b334d0432cfbc3857f42df0 Mon Sep 17 00:00:00 2001
From: voidlizard <dzuikov@gmail.com>
Date: Tue, 11 Feb 2025 12:51:11 +0300
Subject: [PATCH] hbs2-peer extract multicast worker probe

---
 hbs2-core/lib/HBS2/Actors/Peer.hs |  4 ++++
 hbs2-peer/app/Multicast.hs        | 10 ++++++++--
 hbs2-peer/app/PeerMain.hs         | 12 ++++--------
 3 files changed, 16 insertions(+), 10 deletions(-)

diff --git a/hbs2-core/lib/HBS2/Actors/Peer.hs b/hbs2-core/lib/HBS2/Actors/Peer.hs
index 9ba37629..aed50da7 100644
--- a/hbs2-core/lib/HBS2/Actors/Peer.hs
+++ b/hbs2-core/lib/HBS2/Actors/Peer.hs
@@ -398,6 +398,10 @@ newPeerEnv pl s bus p = do
 peerEnvSetProbe :: (MonadIO m) => PeerEnv e -> AnyProbe -> m ()
 peerEnvSetProbe PeerEnv {..} p = liftIO $ atomically $ writeTVar _envProbe p
 
+-- peerEnvAddProbe :: (MonadIO m) => PeerEnv e -> AnyProbe -> m ()
+-- peerEnvAddProbe PeerEnv {..} p = liftIO $ atomically $ modifyTVar _envProbe p
+
+
 peerEnvCollectProbes :: (MonadIO m) => PeerEnv e -> m ()
 peerEnvCollectProbes PeerEnv {..} = do
   probe <- liftIO $ readTVarIO _envProbe
diff --git a/hbs2-peer/app/Multicast.hs b/hbs2-peer/app/Multicast.hs
index 900a7cda..7bdcb319 100644
--- a/hbs2-peer/app/Multicast.hs
+++ b/hbs2-peer/app/Multicast.hs
@@ -70,9 +70,9 @@ multicastWorker :: forall e s m . ( s ~ Encryption e
                                   -- , HasPeerLocator e m
                                   -- , HasPeerNonce L4Proto m
                                   )
-                => PeerConfig -> PeerEnv e -> PeerM e m ()
+                => PeerConfig -> PeerEnv e -> AnyProbe -> PeerM e m ()
 
-multicastWorker conf penv = recover do
+multicastWorker conf penv probe = recover do
 
   debug $ red "multicastWorker started"
 
@@ -93,6 +93,8 @@ multicastWorker conf penv = recover do
 
     menv <- newPeerEnv pl sto (Fabriq mcast) (getOwnPeer mcast)
 
+    peerEnvSetProbe menv probe
+
     ann <- ContT $ withAsync $ do
             localMulticast <- atomically $ takeTMVar localMCast_
             forever do
@@ -102,6 +104,10 @@ multicastWorker conf penv = recover do
               request localMulticast (PeerAnnounce @e pnonce)
               pause w
 
+    void $ ContT $ withAsync $ forever do
+      pause @'Seconds 10
+      peerEnvCollectProbes menv
+
     liftIO $ runPeerM menv $ do
 
       self <- ownPeer @e
diff --git a/hbs2-peer/app/PeerMain.hs b/hbs2-peer/app/PeerMain.hs
index 1711307d..67338576 100644
--- a/hbs2-peer/app/PeerMain.hs
+++ b/hbs2-peer/app/PeerMain.hs
@@ -839,13 +839,6 @@ runPeer opts = respawnOnError opts $ do
 
                            `orDie` "assertion: localMulticastPeer not set"
 
-  -- notice $ "multicast:" <+> pretty localMulticast
-
-  -- mcast <- newMessagingUDPMulticast defLocalMulticast
-  --           `orDie` "Can't start multicast listener"
-
-  -- messMcast <- async $ runMessagingUDP mcast
-
   brains <- newBasicBrains @e conf
 
   bProbe <- newSimpleProbe "Brains"
@@ -1186,7 +1179,10 @@ runPeer opts = respawnOnError opts $ do
 
               flip runContT pure do
 
-                peerThread "multicastWorker" $ multicastWorker conf env
+                mcastProbe <- newSimpleProbe "PeerEnv_Announce"
+                addProbe mcastProbe
+
+                peerThread "multicastWorker" $ multicastWorker conf env mcastProbe
 
                 peerThread "byPassWorker" (byPassWorker byPass)