Поток stdin на Wai.EventSource

Question

Я хотел бы передать поток через HTTP-соединение, используя text/event-stream, Network.Wai.EventSource выглядит как хороший кандидат.

Я пытался использовать этот код:

import Network.Wai
import Network.Wai.EventSource
import Network.Wai.Middleware.AddHeaders
import Network.Wai.Handler.Warp (run)
import qualified Data.ByteString.Lazy as L
import qualified Data.ByteString.Lazy.Char8 as C
import Blaze.ByteString.Builder.ByteString

toEvent :: [L.ByteString] -> ServerEvent
toEvent s = ServerEvent {
    eventName = Nothing,
    eventId = Nothing,
    eventData = map fromLazyByteString s
}

createWaiApp :: IO L.ByteString -> Application
createWaiApp input = eventSourceAppIO $ fmap (toEvent . C.lines) input

main :: IO ()
main = run 1337 $ createWaiApp L.getContents

Что (я думаю) делает:

• Читает STDIN как Ленивый ByteStream
• Разбивает ByteStream на строки
• Создает один ServerEvent для всех строк (это кажется неправильным - должно быть, должно быть несколько событий?)
• Создает приложение WAI из IO ServerEvent
• Привязывает приложение к порту 1337

Когда я запускаю это (например, используя ping -c 5 example.com | stack exec test-exe) он не отвечает, пока весь stdin не будет прочитан.

Как создать приложение Wai, которое сбрасывает HTTP-соединение каждый раз, когда оно читает строку из stdin?

Answer 1

L.getContents это одно действие ввода-вывода, поэтому будет создано только одно событие.

Вот пример eventSourcEventAppIO, где создается несколько событий:

import Blaze.ByteString.Builder.Char8 (fromString)
...same imports as above...

nextEvent :: IO ServerEvent
nextEvent = do
  s <- getLine
  let event = if s == ""
                then CloseEvent
                else ServerEvent
                     { eventName = Nothing
                     , eventId = Nothing
                     , eventData = [ fromString s ]
                     }
  case event of
    CloseEvent ->     putStrLn "<close event>"
    ServerEvent _ _ _ -> putStrLn "<server event>"
  return event

main :: IO ()
main = run 1337 $ eventSourceAppIO nextEvent

Чтобы проверить, в одном окне запустите сервер, а в другом запустите команду curl -v http://localhost:1337, Для каждой строки, которую вы вводите в окне сервера, вы получите фрейм данных из curl. Ввод пустой строки закроет HTTP-соединение, но сервер останется запущенным, что позволит вам снова подключиться к нему.