Good morning my Haskell friends,
I am trying to use server sent events with snap and just can’t seem to get there. Here is the code:
#!/usr/bin/env cabal
{- cabal:
build-depends: base
, snap
, snap-core
, text
, bytestring
, neat-interpolation
-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE TemplateHaskellQuotes #-}
{-# LANGUAGE OverloadedStrings #-}
-- ghci -package snap -package snap-core -package text -package bytestring -package neat-interpolation s.hs
import Control.Applicative
import Snap
import Snap.Util.FileServe
import Data.Text
import Data.Text.Encoding
import Data.ByteString
import Control.Monad.IO.Class
import NeatInterpolation
import Control.Concurrent
main :: IO ()
main = quickHttpServe site
site :: Snap ()
site =
ifTop (writeBS indexHtml) <|>
route [ ("foo", writeBS "bar")
, ("favicon.ico", return ())
, ("sse", handleSse)
] <|>
dir "static" (serveDirectory ".")
handleSse :: Snap ()
handleSse = do
go 0
where
toBS :: String -> ByteString
toBS = encodeUtf8 . Data.Text.pack
go n = do
let msg = "data: " <> show n <> "\n\n"
liftIO $ putStrLn msg
liftIO $ threadDelay 1000000 -- Delay for 1 second
modifyResponse $ setHeader "Content-Type" "text/event-stream"
. setHeader "Cache-Control" "no-cache"
. setHeader "Connection" "keep-alive"
writeBS (toBS msg)
-- getResponse >>= finishWith
go (n + 1)
indexHtml :: ByteString
indexHtml = encodeUtf8 [trimming|
<!DOCTYPE html>
<head>
<script>
var source;
function c() {
console.log("enter c");
source = new EventSource('sse');
source.addEventListener('message', (e) => {
console.log('messge: ' + e.data);
});
source.addEventListener('open', (e) => {
console.log("connection opened");
});
source.addEventListener('error', (e) => {
if (e.readyState == EventSource.CLOSED) {
console.log("connection closed");
}
});
console.log("exit c");
};
</script>
</head>
<body>
<button onclick="c()">click here to connect</button>
</body
|]
The problem seems to that with {getResponse >>= finishWith} commented out, nothing is received by the browser (firefox), and when {getResponse >>= finishWith} executing, the connection is closed and the sse endpoint is re-opened. I have tried probably 20 different permutations of various things with no joy. Has anyone ever gotten server sent events to work with Snap? Please help, hilfe, ayuda, помощь.
Best wishes,
Henry Laxen
