diff options
| author | Roman Smrž <roman.smrz@seznam.cz> | 2026-08-17 19:59:19 +0200 |
|---|---|---|
| committer | Roman Smrž <roman.smrz@seznam.cz> | 2026-08-17 19:59:19 +0200 |
| commit | f2935af7f50b90b78094fa3cffce6ce8c9daf5e0 (patch) | |
| tree | b9e1def0a0919e83be49354910ceab65005c876a | |
| parent | 2ce438155717e4aefecb869a397bc9f7df624add (diff) | |
Fix next peer check race in WebSocket thread
| -rw-r--r-- | erebos-webapp.cabal | 1 | ||||
| -rw-r--r-- | src/WebSocket.hs | 4 |
2 files changed, 4 insertions, 1 deletions
diff --git a/erebos-webapp.cabal b/erebos-webapp.cabal index d9ab240..7c47bc3 100644 --- a/erebos-webapp.cabal +++ b/erebos-webapp.cabal @@ -74,6 +74,7 @@ executable erebos-webapp ghc-experimental ^>= { 9.1201, 9.1202 }, http-types ^>= { 0.12.4 }, mtl ^>= { 2.3 }, + stm ^>= { 2.5 }, text ^>= { 2.1 }, time ^>= { 1.14 }, uuid-types ^>= { 1.0.4 }, diff --git a/src/WebSocket.hs b/src/WebSocket.hs index 685ed90..e00fbe8 100644 --- a/src/WebSocket.hs +++ b/src/WebSocket.hs @@ -7,6 +7,7 @@ module WebSocket ( ) where import Control.Concurrent +import Control.Concurrent.STM import Control.Monad import Data.ByteString (ByteString) @@ -83,8 +84,9 @@ startDefaultWebSocketConnections server = do msg <- receiveMessage conn receivedFromCustomAddress server conn msg + pchan <- getNextPeerChangeChan server void $ forkIO $ void $ forever $ do - peer <- getNextPeerChange server + peer <- atomically $ readTChan pchan isPeerDropped peer >>= \case True -> do wsPeer <- takeMVar peerVar |