haskell Servant Server Sent Events支持

pxiryf3j  于 2023-08-06  发布在  Vant
关注(0)|答案(4)|浏览(269)

如何为servant定义服务器发送事件(SSE)端点。文件似乎不包括这个病例。
如果Servant不是为实时用例设计的,那么哪个Haskell服务器框架支持SSE?

krcsximq

krcsximq1#

servant使用WAI,并且您始终可以使用Raw组合子深入了解普通的WAI应用程序和所有为其存在的库。因此,您可以使用wai-extra中的Network.Wai.EventSource来创建Application,这是Raw端点的处理程序类型。例如:

  1. type MyApi = "normalapi" :> NormalApi
  2. :<|> "sse" :> Raw
  3. myServer :: Server MyAPI
  4. myServer = normalServer :<|> eventSourceAppChan myChan

字符串

lnxxn5zx

lnxxn5zx2#

感谢user2141650的回答,我设法获得了使用通道的服务器发送事件的working example
解决方案的要点如下。假设我们有一个echo服务器,它只回显消息:

  1. newtype Message = Message { msgText :: Text }

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

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


现在让我们看看如何实现端点,将给定会话的消息写入通道:

  1. sendH :: SessionId -> Message -> Handler NoContent
  2. sendH sid msg = do
  3. -- lookupChannel :: Env -> SessionId -> IO (Maybe (Chan ServerEvent))
  4. mCh <- liftIO $ lookupChannel env sid
  5. case mCh of
  6. Nothing ->
  7. throwError err404
  8. Just ch -> do
  9. liftIO $ writeChan ch (asServerEvent msg)
  10. return NoContent


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

  1. import Data.Text.Encoding as TE
  2. import qualified Data.Text.Lazy as T
  3. asServerEvent :: Message -> ServerEvent
  4. asServerEvent msg = ServerEvent
  5. { eventName = Just eName
  6. , eventId = Nothing
  7. , eventData = [msg']
  8. }
  9. where
  10. eName :: Builder
  11. eName = fromByteString "Message arrived"
  12. msg' :: Builder
  13. msg' = fromByteString $ TE.encodeUtf8 $ T.toStrict $ msgText msg


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

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


完整的解决方案可以在我的sanbox上找到。
希望能帮上忙。

展开查看全部
vmpqdwk3

vmpqdwk33#

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

  1. {-# LANGUAGE NoImplicitPrelude #-}
  2. module Spencer.Web.Rest.ServerSentEvents where
  3. import RIO
  4. import qualified RIO.ByteString.Lazy as BL
  5. import Servant
  6. import qualified Network.HTTP.Media as M
  7. -- imitate the Servant JSON and OctetStream implementations
  8. data EventStream deriving Typeable
  9. instance Accept EventStream where
  10. contentType _ = "text" M.// "event-stream"
  11. instance ToSSE a => MimeRender EventStream a where
  12. mimeRender _ = toSSE
  13. -- imitate the ToJSON type class
  14. class ToSSE a where
  15. toSSE :: a -> BL.ByteString
  16. -- my custom type with simple SSE render
  17. data Hello = Hello
  18. instance ToSSE Hello where
  19. toSSE _ = "data: hello!\n\n"
  20. -- my simple SSE server
  21. type MyApi = "sse" :> StreamGet NoFraming EventStream (SourceIO Hello)
  22. myServer :: Server MyAPI
  23. myServer = return $ source [Hello, Hello, Hello]

字符串
浏览器结果:

  1. data: hello!
  2. data: hello!
  3. data: hello!

展开查看全部
bgtovc5b

bgtovc5b4#

是的,我不确定servant中的服务器发送事件,但更全面的Web框架,如Yesod,支持这一点。
查看yesod-eventsource
Yesod有很好的食谱,所以你可以在那里找到很好的example

相关问题