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

hbs2-peer, simple rpc watchdog

This commit is contained in:
voidlizard 2025-02-09 05:51:09 +03:00
parent b2a48c6625
commit 0d25eaa32f
3 changed files with 10 additions and 4 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

6
hbs2-peer/app/BlockDownloadNew.hs
View File

@ -231,13 +231,13 @@ instance MonadUnliftIO m => IsBurstMachine BurstMachine m where
_rates <- newTVarIO (mempty :: Map Double Double) _rates <- newTVarIO (mempty :: Map Double Double)
pause @'Seconds (realToFrac _buTimeout) pause @'Seconds (min 1 $ realToFrac _buTimeout)
flip runContT pure do flip runContT pure do
void $ ContT $ withAsync do void $ ContT $ withAsync do
forever do forever do
pause @'Seconds (realToFrac _buTimeout * 10) pause @'Seconds (min 2 $ realToFrac _buTimeout * 10)
atomically do atomically do
e <- headDef bu0 . Map.elems <$> readTVar _rates e <- headDef bu0 . Map.elems <$> readTVar _rates
@ -293,7 +293,7 @@ instance MonadUnliftIO m => IsBurstMachine BurstMachine m where
pure e2 pure e2
pause @'Seconds dt pause @'Seconds (min 1 dt)
next eNew next eNew
instance MonadIO m => IsBurstMachine ConstBurstMachine m where instance MonadIO m => IsBurstMachine ConstBurstMachine m where

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

@ -58,6 +58,7 @@ import MailboxProtoWorker
import HttpWorker import HttpWorker
import DispatchProxy import DispatchProxy
import PeerMeta import PeerMeta
import Watchdogs
import CLI.Common import CLI.Common
import CLI.RefChan import CLI.RefChan
import CLI.LWWRef import CLI.LWWRef
@ -776,6 +777,8 @@ runPeer opts = respawnOnError opts $ do
let tcpProbeWait = runReader (cfgValue @PeerTcpProbeWaitKey) syn let tcpProbeWait = runReader (cfgValue @PeerTcpProbeWaitKey) syn
& fromInteger @(Timeout 'Seconds) . fromMaybe 300 & fromInteger @(Timeout 'Seconds) . fromMaybe 300
let rpc = getRpcSocketName conf
let let
addProbe :: forall m . MonadIO m => AnyProbe -> m () addProbe :: forall m . MonadIO m => AnyProbe -> m ()
addProbe p = liftIO $ atomically $ modifyTVar probes (p:) addProbe p = liftIO $ atomically $ modifyTVar probes (p:)
@ -1240,6 +1243,8 @@ runPeer opts = respawnOnError opts $ do
peerThread "mailboxProtoWorker" (mailboxProtoWorker (pure mboxConf) mailboxWorker) peerThread "mailboxProtoWorker" (mailboxProtoWorker (pure mboxConf) mailboxWorker)
peerThread "rpcWatchDog" (runRpcWatchDog myself rpc)
liftIO $ withPeerM penv do liftIO $ withPeerM penv do
runProto @e runProto @e
[ makeResponse (blockSizeProto blk onNoBlock) [ makeResponse (blockSizeProto blk onNoBlock)
@ -1304,6 +1309,7 @@ runPeer opts = respawnOnError opts $ do
probe <- newSimpleProbe "PeerEnv_Announce" probe <- newSimpleProbe "PeerEnv_Announce"
addProbe probe addProbe probe
peerEnvSetProbe menv probe peerEnvSetProbe menv probe
probesMenv <- liftIO $ async $ forever do probesMenv <- liftIO $ async $ forever do
pause @'Seconds 10 pause @'Seconds 10
peerEnvCollectProbes menv peerEnvCollectProbes menv
@ -1333,7 +1339,6 @@ runPeer opts = respawnOnError opts $ do
PeerHttpPort Nothing -> mempty PeerHttpPort Nothing -> mempty
PeerHttpPort (Just p) -> "http-port:" <+> pretty p PeerHttpPort (Just p) -> "http-port:" <+> pretty p
let rpc = getRpcSocketName conf
let pokeAnsw = show $ vcat [ "peer-key:" <+> dquotes (pretty (AsBase58 k)) let pokeAnsw = show $ vcat [ "peer-key:" <+> dquotes (pretty (AsBase58 k))
, "udp:" <+> dquotes (pretty (fst . snd <$> udpPoint)) , "udp:" <+> dquotes (pretty (fst . snd <$> udpPoint))

1
hbs2-peer/hbs2-peer.cabal
View File

@ -286,6 +286,7 @@ executable hbs2-peer
, MailboxProtoWorker , MailboxProtoWorker
, CheckMetrics , CheckMetrics
, HttpWorker , HttpWorker
, Watchdogs
, Brains , Brains
, DispatchProxy , DispatchProxy
, CLI.Common , CLI.Common