diff --git a/.fixme/log b/.fixme/log index 193e8f36..0d287101 100644 --- a/.fixme/log +++ b/.fixme/log @@ -1,2 +1,5 @@ -(fixme-set "workflow" "test" "BCXLsnhgWC") \ No newline at end of file +(fixme-set "workflow" "test" "BCXLsnhgWC") +(fixme-set "assigned" "voidlizard" "9Y2v3fXdhz") + +(fixme-set "workflow" "test" "9Y2v3fXdhz") \ No newline at end of file diff --git a/hbs2-core/lib/HBS2/Clock.hs b/hbs2-core/lib/HBS2/Clock.hs index 6d6db9cb..39b04940 100644 --- a/hbs2-core/lib/HBS2/Clock.hs +++ b/hbs2-core/lib/HBS2/Clock.hs @@ -81,3 +81,4 @@ getTimeCoarse = getTime MonotonicCoarse #else getTimeCoarse = getTime Monotonic #endif + diff --git a/hbs2-peer/app/PeerInfo.hs b/hbs2-peer/app/PeerInfo.hs index 3dc513ad..47530bf7 100644 --- a/hbs2-peer/app/PeerInfo.hs +++ b/hbs2-peer/app/PeerInfo.hs @@ -15,6 +15,8 @@ import HBS2.Net.Proto.Types import HBS2.Prelude.Plated import HBS2.System.Logger.Simple +import PeerConfig + import Data.Maybe import Data.Set qualified as Set import Data.List qualified as List @@ -28,6 +30,13 @@ import System.Random.Shuffle import Data.IntSet (IntSet) import Prettyprinter + +data PeerPingIntervalKey + +-- TODO: ping-interval-specifically-for-peer +instance HasCfgKey PeerPingIntervalKey (Maybe Integer) where + key = "ping-interval" + data PeerInfo e = PeerInfo { _peerBurst :: TVar Int @@ -119,8 +128,12 @@ peerPingLoop :: forall e m . ( HasPeerLocator e m , Pretty (Peer e) , MonadIO m ) - => m () -peerPingLoop = do + => PeerConfig -> m () +peerPingLoop cfg = do + + let pingTime = cfgValue @PeerPingIntervalKey cfg + & fromMaybe 30 + & realToFrac wake <- liftIO newTQueueIO @@ -135,7 +148,7 @@ peerPingLoop = do forever do -- FIXME: defaults - r <- liftIO $ race (pause @'Seconds 60) + r <- liftIO $ race (pause @'Seconds pingTime) (atomically $ readTQueue wake) sas' <- liftIO $ atomically $ flushTQueue wake <&> mconcat @@ -160,7 +173,7 @@ peerPingLoop = do fnum <- liftIO $ readTVarIO pfails fdown <- liftIO $ readTVarIO pdownfails - when (fnum > 3) do -- FIXME: hardcode! + when (fnum > 2) do -- FIXME: hardcode! warn $ "removing peer" <+> pretty p <+> "for not responding to our pings" delPeers pl [p] expire (PeerInfoKey p) diff --git a/hbs2-peer/app/PeerMain.hs b/hbs2-peer/app/PeerMain.hs index 483a4447..32896256 100644 --- a/hbs2-peer/app/PeerMain.hs +++ b/hbs2-peer/app/PeerMain.hs @@ -74,6 +74,7 @@ import System.IO import System.Metrics +-- TODO: write-workers-to-config defStorageThreads :: Integral a => a defStorageThreads = 4 @@ -609,7 +610,7 @@ runPeer opts = Exception.handle myException $ do peerThread (checkMetrics metrics) - peerThread (peerPingLoop @e) + peerThread (peerPingLoop @e conf) peerThread (knownPeersPingLoop @e conf) diff --git a/hbs2/Main.hs b/hbs2/Main.hs index da7cb6dc..cc967bd9 100644 --- a/hbs2/Main.hs +++ b/hbs2/Main.hs @@ -626,7 +626,8 @@ main = join . customExecParser (prefs showHelpOnError) $ forM_ rs $ \(h,f) -> do print $ fill 24 (pretty f) <+> pretty h - -- TODO: reflog-del-command + + -- TODO: reflog-del-command-- TODO: reflog-del-command pDel = do o <- common h <- strArgument ( metavar "HASH" )