Use exponential distribution for P2P session timeouts

src/P2P/Node.hs

@@ -3,8 +3,10 @@
 {-# LANGUAGE DeriveAnyClass #-}
 {-# LANGUAGE DeriveGeneric #-}
 {-# LANGUAGE DerivingStrategies #-}
+{-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE MultiWayIf #-}
+{-# LANGUAGE NumericUnderscores #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE RankNTypes #-}
 {-# LANGUAGE ScopedTypeVariables #-}
@@ -585,26 +587,43 @@ newSession conf node = do
             let env = peerClientEnv node newPeerInfo
             (info, newSes) <- mask $ \restore -> do
                 now <- getCurrentTimeIntegral
-                t <- R.randomRIO
-                    ( round (0.9 * timeoutMs)
-                    , round (1.1 * timeoutMs)
-                    )
-                !newSes <- async $ restore $ timeout t
+                t <- sessionTimeout $ secondsToTimeSpan $ _p2pConfigSessionTimeout conf
+                !newSes <- async $ restore $ timeout (int $ timeSpanToMicros t)
                     $ _p2pNodeClientSession node (loggFun node) env newPeerInfo
                 incrementActiveSessionCount peerDb newPeerInfo
                 !info <- atomically $ addSession node newPeerInfo newSes now
                 return (info, newSes)
             logg node Debug $ "Started peer session " <> showSessionId newPeerInfo newSes
             loggFun node Info $ JsonLog info
   where
-    TimeSpan timeoutMs = secondsToTimeSpan @Double (_p2pConfigSessionTimeout conf)
     peerDb = _p2pNodePeerDb node
 
     syncFromPeer_ pinfo
         | _p2pConfigPrivate conf = return True
         | _p2pNodeDoPeerSync node = syncFromPeer node pinfo
         | otherwise = return True
 
+-- | (Roughly) exponentially distributed timespans with the given expectation
+-- within the range of a a tenth of the expectation and ten times the
+-- expectation.
+--
+-- The expected value of the actual distribution gets increasinly imprecise
+-- as the input value gets smaller, because a minimum result of 5 seconds
+-- is implemented. Input values of less than 30s should be avoided.
+--
+sessionTimeout :: TimeSpan Int -> IO (TimeSpan Int)
+sessionTimeout expected = do
+    x <- exponential (1 / us) :: IO Double
+    return $! microsToTimeSpan $ round $ max lower $ min upper x
+  where
+    us = int $ timeSpanToMicros expected
+    lower = max 5_000_000 (us / 10) -- at least 5 seconds
+    upper = us * 10
+
+    exponential rate = do
+        !x <- R.getStdRandom (R.randomR (0, 1))
+        return $! - log x / rate
+
 -- | Monitor and garbage collect sessions
 --
 awaitSessions :: P2pNode -> IO ()