From 6df825226d28f77840eaca53d607081691cb1dc7 Mon Sep 17 00:00:00 2001 From: voidlizard Date: Mon, 17 Feb 2025 06:01:09 +0300 Subject: [PATCH] maybe fix TCP busyloop --- hbs2-core/lib/HBS2/Net/Messaging/TCP.hs | 13 ++++++------- 1 file changed, 6 insertions(+), 7 deletions(-) diff --git a/hbs2-core/lib/HBS2/Net/Messaging/TCP.hs b/hbs2-core/lib/HBS2/Net/Messaging/TCP.hs index ed6c92c1..ef061a24 100644 --- a/hbs2-core/lib/HBS2/Net/Messaging/TCP.hs +++ b/hbs2-core/lib/HBS2/Net/Messaging/TCP.hs @@ -39,6 +39,7 @@ import Network.Socket hiding (listen,connect) import System.Random hiding (next) import Control.Monad.Trans.Cont import Control.Exception +import Control.Concurrent.STM qualified as STM import UnliftIO (MonadUnliftIO(..)) import UnliftIO.Async @@ -391,16 +392,14 @@ runMessagingTCP env@MessagingTCP{..} = liftIO do -- client sockets -- смотрим к кому надо - who <- atomically $ readTQueue _tcpConnDemand - whoAddr <- toPeerAddr who + who <- atomically do + who <- readTQueue _tcpConnDemand + already <- readTVar _tcpPeerConn <&> HM.member who + if not already then pure who else STM.retry debug $ "DEMAND:" <+> pretty who - already <- atomically $ readTVar _tcpPeerConn <&> HM.member who - - when already do - debug "SHIT? BUSYLOOP?" - mzero + whoAddr <- toPeerAddr who liftIO $ newClientThread env $ do let (L4Address _ (IPAddrPort (ip,port))) = whoAddr