haskell - Websockets + 仆人服务器

Question

我正在尝试使 websockets 与servant-server 一起工作:

{-# LANGUAGE DataKinds         #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TypeOperators     #-}

import           Control.Monad.IO.Class
import           Data.Text                (Text)
import           Network.Wai.Handler.Warp (run)
import           Network.WebSockets
import           Servant                  hiding (route)
import           Servant.API.WebSocket

type API = Raw
  :<|> "game" :> WebSocketPending

myAPI :: Proxy API
myAPI = Proxy

server :: Server API
server = serveDirectoryFileServer "site"
  :<|> game "From socket server"

game :: MonadIO m => Text -> PendingConnection -> m ()
game msg pending = do
  conn <- liftIO $ acceptRequest pending
  liftIO $ sendTextData conn msg

app :: Application
app = serve myAPI server

main :: IO ()
main = run 8080 app

目的是发送一个字符串 From socket server返回给客户进行测试。
在 Firefox 控制台中:

// Create WebSocket connection.
socket = new WebSocket('ws://localhost:8080/game');

// Connection opened
socket.addEventListener('open', function (event) {
    socket.send('Hello Server!');
});

// Listen for messages
socket.addEventListener('message', function (event) {
    console.log('Message from server ', event.data);
});

我从 Firefox 中收到错误消息:

Firefox can’t establish a connection to the server at ws://localhost:8080/game

有人可以给我一个提示吗？
更新:
这是重新排序 API 后工作的代码。

type API = "game" :> WebSocketPending
  :<|> Raw

myAPI :: Proxy API
myAPI = Proxy

server :: Server API
server = game
  :<|> serveDirectoryFileServer "site"

game :: MonadIO m => PendingConnection -> m ()
game pending = do
  conn <- liftIO $ acceptRequest pending
  liftIO $ withPingThread conn 30 (return ()) $ do
    forever $ do
      msg <- receiveData conn :: IO Text
      sendTextData conn msg

Answer 1

问题原来是类型定义中 API 端点的顺序。
类型组合器(:<|>)在 docs 中有描述， 作为

Union of two APIs, first takes precedence in case of overlap.

自 Raw基本上匹配所有内容，您的原始定义将所有请求视为“原始”请求，从不转发到您的 Websocket 服务器。
只需将参数的顺序切换为 (:<|>)在类型和 server 中定义 - 正如您所观察到的那样，解决了这个问题。