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 ())