haskell TCP 服務器向所有連接發送傳入消息

Question

在 haskell 中編寫 tcp 服務器的最佳方法是什么，該服務器維護所有打開的連接池並將其接收到的所有消息發送到所有連接？

基本上是這個nodejs代碼的翻譯

import net from "net";

const conns = [];

net.createServer((socket) => {
    conns.push(socket);

    socket.on("data", (data) => {
        for (const conn of conns) {
            conn.write(data);
        }
    });

    socket.on("close", () => {
        conns.splice(conns.indexOf(socket), 1);
    });
}).listen(1337);

Answer 1

總是很難說什么是“最好的”方式。 這是一種方法：

import Control.Concurrent
import Control.Concurrent.Async  -- from async
import Control.Monad
import Control.Monad.Loops       -- from monad-loops
import Network.Simple.TCP        -- from network-simple

chunk = 4096

main = do
  bcast <- newChan
  forkIO $ forever $ readChan bcast
  serve (Host "127.0.0.1") "8080" $ \(s, addr) -> do
    bcast' <- dupChan bcast
    race_ (forever $ readChan bcast' >>= send s)
          (whileJust_ (recv s 4096) $ writeChan bcast')

更詳細地說， Control.Concurrent具有通過dupChan操作支持簡單廣播操作的通道。 在這里，我們創建一個主廣播頻道：

bcast <- newChan

可以寫入此主通道及其通過dupChan創建的任何副本，並且生成的數據將在所有副本上可用。

因為我們將只使用主通道進行復制而不是讀取和寫入，所以我們需要分叉一個線程來排空它，這樣數據就不會累積：

forkIO $ forever $ readChan bcast

現在，我們使用serve來服務客戶。 對於每個連接的客戶端，都會運行 do-block：

serve (Host "127.0.0.1") "8080" $ \(s, addr) -> do ...

在 do-block 中，我們創建主通道的每個客戶端副本：

bcast' <- dupChan bcast

然后，我們分叉兩個線程，一個讀取bcast'頻道上的任何數據廣播並將其發送到套接字，另一個從套接字讀取輸入並廣播它。 我們race_這些線程進行比賽，以便如果其中一個完成，另一個將被殺死：

race_ (forever $ readChan bcast' >>= send s)
      (whileJust_ (recv s 4096) $ writeChan bcast')

通常，如果客戶端斷開連接， recv將返回Nothing ，第二個線程將結束。 這將導致race_殺死第一個。

然而，有一個小的競爭條件。 如果客戶端斷開連接並且在第二個線程返回之前第一個線程發送並處理了廣播並且race_殺死了第一個，則send將引發異常。 這將導致race_殺死第二個線程（根據需要），然后重新引發異常，從而導致控制台上出現丑陋的錯誤消息。

如果您想避免這種情況，您可以將race_替換為如下定義的raceQuietly_ ：

import Control.Exception.Safe

raceQuietly_ x y = race_ x y `catchIO` (\_ -> return ())