9Y2v3fXdhz lesser-ping-period

.fixme/log

@@ -1,2 +1,5 @@
 
 (fixme-set "workflow" "test" "BCXLsnhgWC")
+(fixme-set "assigned" "voidlizard" "9Y2v3fXdhz")
+
+(fixme-set "workflow" "test" "9Y2v3fXdhz")

hbs2-core/lib/HBS2/Clock.hs

@@ -81,3 +81,4 @@ getTimeCoarse = getTime MonotonicCoarse
 #else
 getTimeCoarse = getTime Monotonic
 #endif
+

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 ()
+             => PeerConfig -> m ()
-peerPingLoop = do
+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)

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)
 

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" )