Skip to content


Subversion checkout URL

You can clone with
Download ZIP
Tree: d68db20a47
Fetching contributors…

Cannot retrieve contributors at this time

55 lines (43 sloc) 1.861 kB
{-# LANGUAGE OverloadedStrings #-}
module Main where
import Control.Applicative((<|>))
import Control.Monad.Trans(liftIO)
import Control.Concurrent.Chan(Chan, readChan, dupChan)
import Snap.Types
import Snap.Util.FileServe(serveFile, serveDirectory)
import Snap.Http.Server(quickHttpServe)
import Data.ByteString(ByteString)
import Blaze.ByteString.Builder(fromByteString)
import qualified System.UUID.V4 as UUID
import AMQPListener(AMQPEvent(..), openEventChannel)
import EventStream(ServerEvent(..), eventStreamPull)
-- |Setup a channel listening to an AMQP exchange and start Snap
main :: IO ()
main = do
uuid <- UUID.uuid
listener <- openEventChannel "eventsource.fanout" $ "eventsource." ++ (show uuid)
quickHttpServe $
ifTop (serveFile "static/index.html") <|>
dir "static" (serveDirectory "static") <|>
route [ ("eventsource", eventSource listener) ]
-- |Stream events from a channel of AMQPEvents to EventSource
eventSource :: Chan AMQPEvent -> Snap ()
eventSource chan = do
chan' <- liftIO $ dupChan chan
channelParam <- getParam "channel"
case channelParam of
Just channelId -> eventStreamPull $ filterEvents channelId chan'
Nothing -> do
modifyResponse $ setResponseCode 401
writeBS "Bad Request - no channel id"
r <- getResponse
finishWith r
-- |Filter AMQPEvents by channelId
filterEvents :: ByteString -> Chan AMQPEvent -> IO ServerEvent
filterEvents channelId chan = do
event <- readChan chan
if amqpChannel event == channelId
then return $ ServerEvent (toBS $ amqpName event) (toBS $ amqpId event) [fromByteString $ amqpData event]
else filterEvents channelId chan
toBS = fmap fromByteString
Jump to Line
Something went wrong with that request. Please try again.