如何使用wai与http-client实现支持Server-Sent Events的代理？

你直接将H.responseBody传入W.responseStream无法实现流式传输，核心原因是默认情况下HTTP Client的httpLbs（或未配置流式的http）会把整个响应体加载到内存中，返回的ResponseBody是完整的字节串，自然会一次性返回给客户端。要实现流式代理，需要让HTTP Client以流的方式读取目标响应，再逐块转发给WAI的流处理器。

关键实现步骤与代码示例 #

1. 依赖准备：确保引入streaming-bytestring库处理流式字节串，同时使用HTTP Client的流式请求API。
2. 配置流式请求：使用H.http而非H.httpLbs，并关闭响应超时（SSE是长连接）。
3. 构造WAI流式响应体：将HTTP Client的流式响应体逐块转发给WAI的发送回调。

import qualified Network.HTTP.Client                  as H
import qualified Network.Wai                          as W
import qualified Data.ByteString.Streaming            as SBS
import Data.ByteString (ByteString)
import Control.Monad.IO.Class (liftIO)

-- 初始化HTTP Client管理器
manager <- H.newManager H.defaultManagerSettings

-- 构建目标SSE请求
let targetRequest = H.defaultRequest
      { H.host = "your-target-server.com"
      , H.path = "/sse-stream-endpoint"
      , H.requestHeaders = [("Accept", "text/event-stream")]
      -- 关闭响应超时，适配SSE长连接
      , H.requestResponseTimeout = H.responseTimeoutNone
      }

-- 发送流式请求，获取响应体流
targetResponse <- H.http targetRequest manager

-- 构造WAI的StreamingBody：逐块转发数据
let proxyStream send flush = do
      -- 将HTTP Client的流式响应体转为Streaming ByteString
      let bodyStream = H.responseBody targetResponse :: SBS.ByteString IO ()
      -- 逐块发送并刷新，确保数据实时推送
      SBS.mapM_ (\chunk -> liftIO $ send chunk >> flush) bodyStream
      -- 结束时触发刷新
      liftIO flush

-- 返回WAI流式响应
respond $ W.responseStream
  (H.responseStatus targetResponse)
  -- 强制添加SSE的Content-Type头
  (("Content-Type", "text/event-stream") : H.responseHeaders targetResponse)
  proxyStream

核心注意点 #

• 必须使用H.http发起请求：H.httpLbs会将响应体全部读入内存，失去流式特性。
• 关闭响应超时：SSE是长连接，默认超时会导致连接中途断开。
• 逐块调用flush：WAI默认会缓存数据，flush能强制将当前块数据立即发送到客户端。
• 确保响应头包含text/event-stream：客户端需要这个头来识别SSE流。

内容的提问来源于stack exchange，提问作者unhammer