仆人服务器发送事件支持

Question

如何为仆人定义服务器发送事件 (SSE) 端点。文档似乎没有涵盖这种情况。

如果 Servant 不是为实时用例设计的，哪个 Haskell 服务器框架支持 SSE？

Answer 1

是的，我不确定 servant 中的服务器发送事件，但是 Yesod 等更全面的 Web 框架支持该功能。

Yesod 有相当不错的食谱，所以你可以在那里找到相当不错的东西 example

Answer 2

servant 使用 WAI，并且您始终可以使用 Raw 组合器深入研究普通 WAI 应用程序和为它存在的所有库。因此，您可以使用 wai-extra 中的 Network.Wai.EventSource 创建一个 Application，这是 Raw 端点的处理程序类型。类似于：

type MyApi = "normalapi" :> NormalApi 
        :<|> "sse" :> Raw

myServer :: Server MyAPI
myServer = normalServer :<|> eventSourceAppChan myChan

Answer 3

感谢user2141650 I managed to get a working example of a server-sent events that uses channels的回答。

解决方案的要点如下。假设我们有一个只回显消息的回显服务器：

newtype Message = Message { msgText :: Text }

然后我们将定义三个 end-points，一个用于创建会话，一个用于向会话发送消息，另一个用于使用 server-sent 事件检索会话的消息：

# Create a new session
curl -v -XPOST http://localhost:8081/session/new
# And subscribe to its events
curl -v http://localhost:8081/events/0
# And from another terminal
curl -v -XPOST http://localhost:8081/session/0/echo\
     -H "Content-Type: application/json" -d '{"msgText": "Hello"}'

现在让我们看看如何实现 end-point 将给定会话的消息写入频道：

sendH :: SessionId -> Message -> Handler NoContent
sendH sid msg = do
    -- lookupChannel :: Env -> SessionId -> IO (Maybe (Chan ServerEvent))
    mCh <- liftIO $ lookupChannel env sid
    case mCh of
        Nothing ->
            throwError err404
        Just ch -> do
            liftIO $ writeChan ch (asServerEvent msg)
            return NoContent

将Message转换为ServerEvent的函数如下所示：

import           Data.Text.Encoding          as TE
import qualified Data.Text.Lazy              as T

asServerEvent :: Message -> ServerEvent
asServerEvent msg = ServerEvent
    { eventName = Just eName
    , eventId = Nothing
    , eventData = [msg']
    }
    where
      eName :: Builder
      eName = fromByteString "Message arrived"
      msg'  :: Builder
      msg'  = fromByteString $ TE.encodeUtf8 $ T.toStrict $ msgText msg

最后，可以使用 evetSourceAppChan 实现从服务器检索消息的处理程序，如下所示：

eventsH sid = Tagged $ \req respond -> do
    mCh <- lookupChannel env sid
    case mCh of
        Nothing -> do
            let msg = "Could not find session with id: "
                   <> TLE.encodeUtf8 (T.pack (show sid))
            respond $ responseLBS status404 [] msg
        Just ch -> do
            ch' <- dupChan ch
            eventSourceAppChan ch req respond

我的 sanbox.

提供了完整的解决方案

希望对您有所帮助。

Answer 4

Servant 只需一点样板就可以很好地处理这个问题。在这种情况下，您需要一个新的内容类型 (EventStream) 和一个支持 class 来将类型呈现为 SSE 格式。

{-# LANGUAGE NoImplicitPrelude #-}
module Spencer.Web.Rest.ServerSentEvents where

import RIO
import qualified RIO.ByteString.Lazy as BL
import Servant
import qualified Network.HTTP.Media as M

-- imitate the Servant JSON and OctetStream implementations
data EventStream deriving Typeable

instance Accept EventStream where
  contentType _ = "text" M.// "event-stream"

instance ToSSE a => MimeRender EventStream a where
  mimeRender _ = toSSE

-- imitate the ToJSON type class
class ToSSE a where
  toSSE :: a -> BL.ByteString


-- my custom type with simple SSE render
data Hello = Hello

instance ToSSE Hello where
  toSSE _ = "data: hello!\n\n"

-- my simple SSE server
type MyApi = "sse" :> StreamGet NoFraming EventStream (SourceIO Hello)

myServer :: Server MyAPI
myServer =  source [Hello, Hello, Hello]

浏览器结果：

data: hello!

data: hello!

data: hello!

仆人服务器发送事件支持

Servant Server Sent Events support

haskell

servant