/src/AMQPEvents.hs

 1{-# LANGUAGE OverloadedStrings #-}
 2module AMQPEvents
 3    (
 4      AMQPEvent(..)
 5    , Channel
 6    , openEventChannel
 7    , publishEvent
 8    ) where
 9
10import           Control.Applicative((<$>), (<*>))
11import           Control.Monad(mzero)
12import           Control.Monad.Fix(fix)
13import           Control.Concurrent(forkIO)
14import           Control.Concurrent.Chan(Chan, newChan, readChan, writeChan)
15
16import           Data.Aeson(FromJSON(..), ToJSON(..), Value(..), Result(..), fromJSON, toJSON, object, json, encode, (.:), (.:?), (.=))
17import           Data.Attoparsec(parse, maybeResult)
18
19import qualified Data.ByteString as B
20import qualified Data.ByteString.Lazy as LB
21
22import           Data.Maybe(fromJust, fromMaybe)
23import           Data.String.Utils(split)
24
25import           Text.URI(URI(..), parseURI)
26import           System.Posix.Env(getEnvDefault)
27import           Network.AMQP
28
29-- |Wraps a AMQPChannel to publish on and a listerner chan to read from
30type AMQPConn = (Channel, Chan AMQPEvent)
31
32-- |The AMQPEvent represents and incomming message that should be
33-- mapped to an EventSource event.
34data AMQPEvent = AMQPEvent
35    { amqpChannel :: B.ByteString
36    , amqpUser    :: B.ByteString
37    , amqpData    :: B.ByteString
38    , amqpId      :: Maybe B.ByteString
39    , amqpName    :: Maybe B.ByteString 
40    }
41
42instance FromJSON AMQPEvent where
43    parseJSON (Object v) = AMQPEvent <$>
44                           v .: "channel" <*>
45                           v .: "user"    <*>
46                           v .: "data"    <*>
47                           v .:? "id"     <*>
48                           v .:? "name"
49    parseJSON _           = mzero
50
51instance ToJSON AMQPEvent where
52    toJSON (AMQPEvent c u d i n) = object ["channel" .= c, "user" .= u, "data" .= d, "id" .= i, "name" .= n]
53
54exchange = "eventsource.fanout"
55
56-- |Connects to an AMQP broker.
57-- Tries to get credentials, host and vhost from the AMQP_URL
58-- environment variable
59-- Take an exchange name and a queue name
60openEventChannel :: String -> IO AMQPConn
61openEventChannel queue = do
62    amqpURI <- getEnvDefault "AMQP_URL" "amqp://guest:guest@127.0.0.1/"
63
64    let uri   = fromJust $ parseURI amqpURI
65    let auth  = fromMaybe "guest:guest" $ uriUserInfo uri
66    let host  = fromMaybe "127.0.0.1"   $ uriRegName uri
67    let vhost = uriPath uri
68
69    let [user,password] = split ":" auth
70
71    conn <- openConnection host vhost user password
72    chan <- openChannel conn
73
74    declareQueue chan newQueue {queueName = queue, queueAutoDelete = True, queueDurable = False}
75    declareExchange chan newExchange {exchangeName = exchange, exchangeType = "fanout", exchangeDurable = False}
76    bindQueue chan queue exchange queue
77
78    listener <- newChan
79    forkIO $ fix $ \loop -> readChan listener >> loop
80    consumeMsgs chan queue NoAck (sendTo listener)
81    return (chan, listener)
82
83
84publishEvent chan queue event =
85    publishMsg chan exchange queue
86        newMsg {msgBody = encode event}
87
88
89-- |Write messages from AMQP to a channel
90sendTo :: Chan AMQPEvent -> (Message, Envelope) -> IO ()
91sendTo chan (msg, _) =
92    case maybeResult $ parse json (B.concat $ LB.toChunks (msgBody msg)) of
93        Just value -> case fromJSON value of
94            Success event -> do
95                writeChan chan event
96            Error _       -> do
97                return ()
98        Nothing    -> return ()