module Snap.Snaplet.AMQP
( initAMQP
, runAmqp
, mkAmqpConn
, AmqpState (..)
, HasAmqpConn (..)
) where
import Control.Monad.State
import Control.Monad.Trans.Reader
import Data.Configurator
import Data.Configurator.Types
import Network.AMQP (Channel, Connection, openChannel,
openConnection')
import Network.Socket (PortNumber (..))
import Paths_snaplet_amqp
import Snap.Snaplet
type AmqpC = (Connection, Channel)
newtype AmqpState = AmqpState { amqpConn :: AmqpC }
class MonadIO m => HasAmqpConn m where
getAmqpConn :: m AmqpC
instance HasAmqpConn (Handler b AmqpState) where
getAmqpConn = gets amqpConn
instance MonadIO m => HasAmqpConn (ReaderT AmqpC m) where
getAmqpConn = ask
initAMQP :: SnapletInit b AmqpState
initAMQP = makeSnaplet "persist" description datadir $ do
c <- mkSnapletAmqpConn
return $ AmqpState c
where
description = "Snaplet for AMQP library"
datadir = Just $ liftM (++"/resources/amqp") getDataDir
mkSnapletAmqpConn :: (MonadIO (m b v), MonadSnaplet m) => m b v AmqpC
mkSnapletAmqpConn = do
conf <- getSnapletUserConfig
mkAmqpConn conf
mkAmqpConn :: MonadIO m => Config -> m AmqpC
mkAmqpConn conf = do
host <- liftIO $ require conf "host"
port <- liftIO $ require conf "port"
vhost <- liftIO $ require conf "vhost"
login <- liftIO $ require conf "login"
pass <- liftIO $ require conf "password"
conn <- liftIO $ openConnection' host (PortNum port) vhost login pass
chan <- liftIO $ openChannel conn
return (conn, chan)
runAmqp :: (HasAmqpConn m) => (AmqpC -> b) -> m b
runAmqp action = getAmqpConn >>= return . action