Fix next peer check race in WebSocket thread

1 files changed, 3 insertions, 1 deletions

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