Servant Server Sent Events支持

Question

如何为servant定义服务器发送事件(SSE)终结点。文档似乎没有涵盖这个案例。

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

Answer 1

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 2

多亏了user2141650的回答，我设法获得了一个使用channels的服务器发送事件的working example。

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

newtype Message = Message { msgText :: Text }

然后我们将定义三个端点，一个用于创建会话，一个用于向会话发送消息，另一个用于使用服务器发送的事件检索会话的消息：

# 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"}'

现在，让我们看看如何实现端点，以便将给定会话的消息写入通道：

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 3

是的，我不确定servant中是否有服务器发送的事件，但是像Yesod这样更全面的Web框架支持这一点。

请看一下yesod-eventsource包

Yesod有非常好的食谱，所以你可以在那里找到非常好的example