voidlizard
/
hbs2
mirror of https://github.com/voidlizard/hbs2
1
0
Fork 0
Code Issues Packages Projects Releases Wiki Activity

hbs2-peer extract multicast worker probe

This commit is contained in:
voidlizard 2025-02-11 12:51:11 +03:00
parent 9346e8311d
commit 57b480a454
3 changed files with 16 additions and 10 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
hbs2-core/lib/HBS2/Actors/Peer.hs
View File

@ -398,6 +398,10 @@ newPeerEnv pl s bus p = do
peerEnvSetProbe :: (MonadIO m) => PeerEnv e -> AnyProbe -> m () peerEnvSetProbe :: (MonadIO m) => PeerEnv e -> AnyProbe -> m ()
peerEnvSetProbe PeerEnv {..} p = liftIO $ atomically $ writeTVar _envProbe p 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 :: (MonadIO m) => PeerEnv e -> m ()
peerEnvCollectProbes PeerEnv {..} = do peerEnvCollectProbes PeerEnv {..} = do
probe <- liftIO $ readTVarIO _envProbe probe <- liftIO $ readTVarIO _envProbe

10
hbs2-peer/app/Multicast.hs
View File

@ -70,9 +70,9 @@ multicastWorker :: forall e s m . ( s ~ Encryption e
-- , HasPeerLocator e m -- , HasPeerLocator e m
-- , HasPeerNonce L4Proto 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" debug $ red "multicastWorker started"
@ -93,6 +93,8 @@ multicastWorker conf penv = recover do
menv <- newPeerEnv pl sto (Fabriq mcast) (getOwnPeer mcast) menv <- newPeerEnv pl sto (Fabriq mcast) (getOwnPeer mcast)
peerEnvSetProbe menv probe
ann <- ContT $ withAsync $ do ann <- ContT $ withAsync $ do
localMulticast <- atomically $ takeTMVar localMCast_ localMulticast <- atomically $ takeTMVar localMCast_
forever do forever do
@ -102,6 +104,10 @@ multicastWorker conf penv = recover do
request localMulticast (PeerAnnounce @e pnonce) request localMulticast (PeerAnnounce @e pnonce)
pause w pause w
void $ ContT $ withAsync $ forever do
pause @'Seconds 10
peerEnvCollectProbes menv
liftIO $ runPeerM menv $ do liftIO $ runPeerM menv $ do
self <- ownPeer @e self <- ownPeer @e

12
hbs2-peer/app/PeerMain.hs
View File

@ -839,13 +839,6 @@ runPeer opts = respawnOnError opts $ do
`orDie` "assertion: localMulticastPeer not set" `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 brains <- newBasicBrains @e conf
bProbe <- newSimpleProbe "Brains" bProbe <- newSimpleProbe "Brains"
@ -1186,7 +1179,10 @@ runPeer opts = respawnOnError opts $ do
flip runContT pure 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) peerThread "byPassWorker" (byPassWorker byPass)