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