@@ -1,28 +1,26 @@
11{-# LANGUAGE OverloadedStrings #-}
22module Main where
33
4−import Control.Monad
4+import Blaze.ByteString.Builder.Char.Utf8 (fromString)
55import Control.Concurrent (forkIO, threadDelay)
6−import Control.Monad.Trans (liftIO)
76import Control.Concurrent.Chan
7+import Control.Monad
8+import Data.Time.Clock.POSIX (getPOSIXTime)
9+import Network.HTTP.Types (status200)
10+import Network.Wai (Application, Middleware, pathInfo, responseFile)
11+import Network.Wai.EventSource (ServerEvent(..), eventSourceAppChan, eventSourceAppIO)
812import Network.Wai.Handler.Warp (run)
13+import Network.Wai.Middleware.AddHeaders (addHeaders)
914import Network.Wai.Middleware.Gzip (gzip, def)
10−import Network.Wai
11−import Network.HTTP.Types (status200)
12−import Data.Time.Clock.POSIX
13−import Blaze.ByteString.Builder.Char.Utf8 (fromString)
14−import qualified Data.Conduit as C
1515
16−import Network.Wai.EventSource
1716
1817app :: Chan ServerEvent -> Application
19−app chan req =
18+app chan req respond =
2019 case pathInfo req of
21− [] -> return $ ResponseFile status200 [("Content-Type", "text/html")] "static/index.html" Nothing
22− ["esold"] -> eventSourceAppChan chan req
23− ["eschan"] -> eventSourceAppChan chan req
24− ["esio"] -> eventSourceAppIO eventIO req
25− ["essrc"] -> eventSourceAppSource eventSource req
20+ [] -> respond $ responseFile status200 [("Content-Type", "text/html")] "example/index.html" Nothing
21+ ["esold"] -> eventSourceAppChan chan req respond
22+ ["eschan"] -> eventSourceAppChan chan req respond
23+ ["esio"] -> eventSourceAppIO eventIO req respond
2624 _ -> error "unexpected pathInfo"
2725
2826eventChan :: Chan ServerEvent -> IO ()
@@ -39,17 +37,15 @@ eventIO = do
3937 Nothing
4038 [fromString . show $ time]
4139
42−eventSource :: C.Source (C.ResourceT IO) ServerEvent
43−eventSource = forever $ do
44− time <- liftIO $ do
45− threadDelay 1000000
46− getPOSIXTime
47− C.yield $ ServerEvent (Just $ fromString "source")
48− Nothing
49− [fromString . show $ time]
50−
40+main :: IO ()
5141main = do
5242 chan <- newChan
5343 _ <- forkIO . eventChan $ chan
54− run 8080 (gzip def $ app chan)
55−
44+ run 8080 (gzip def $ headers $ app chan)
45+ where
46+ -- headers required for SSE to work through nginx
47+ -- not required if using warp directly
48+ headers :: Middleware
49+ headers = addHeaders [ ("X-Accel-Buffering", "no")
50+ , ("Cache-Control", "no-cache")
51+ ]