Servant Server Sent Events support

Question

How do I define a Server-Sent Event(SSE) end point for servant. The docs don't seem to cover this case.

If Servant is not designed for the realtime use case, which Haskell server framework supports SSE?

Answer 1

servant uses WAI, and you can always dip down into normal WAI applications and all the libraries that exist for it with the Raw combinator. So you can use Network.Wai.EventSource from wai-extra to create an Application, which is the type of handlers for Raw endpoints. Something like:

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

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

Answer 2

Thanks to the answer of user2141650 I managed to get a working example of a server-sent events that uses channels.

The gist of the solution is as follows. Assume that we have an echo server that just echoes messages:

newtype Message = Message { msgText :: Text }

Then we'll define three end-points, one for creating sessions, one for sending messages to a session, and the other for retrieving the messages of a session using server-sent events:

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

Now let's see how to implement the end-point to write a message for a given session, into a channel:

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

The function to convert a Message to a ServerEvent is shown below:

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

Finally, the handler for retrieving the messages from the server can be implemented using evetSourceAppChan, as follows:

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

The full solution is available at my sanbox.

I hope that helps.