module Snap.Snaplet.AMQP
( initAMQP
, runAmqp
, mkAmqpPool
, AmqpState (..)
, HasAmqpPool (..)
) where
import Control.Monad.State
import Control.Monad.Trans.Reader
import Data.Configurator
import Data.Configurator.Types
import Data.Pool
import Network.AMQP
import Paths_snaplet_amqp
import Snap.Snaplet
type AmqpPool = Pool Connection
newtype AmqpState = AmqpState { amqpPool :: AmqpPool }
class MonadIO m => HasAmqpPool m where
getAmqpPool :: m AmqpPool
instance HasAmqpPool (Handler b AmqpState) where
getAmqpPool = gets amqpPool
instance MonadIO m => HasAmqpPool (ReaderT AmqpPool m) where
getAmqpPool = ask
initAMQP :: SnapletInit b AmqpState
initAMQP = makeSnaplet "amqp" description datadir $ do
p <- mkSnapletAmqpPool
onUnload (destroyAllResources p)
return $ AmqpState p
where
description = "Snaplet for AMQP library"
datadir = Just $ liftM (++"/resources/amqp") getDataDir
mkSnapletAmqpPool :: (MonadIO (m b v), MonadSnaplet m) => m b v AmqpPool
mkSnapletAmqpPool = do
conf <- getSnapletUserConfig
mkAmqpPool conf
mkAmqpPool :: MonadIO m => Config -> m AmqpPool
mkAmqpPool 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"
let connOpts = defaultConnectionOpts
{ coServers = [(host, (fromInteger port))]
, coVHost = vhost
, coAuth = [plain login pass]
}
return =<< liftIO $ createPool (openConnection'' connOpts) closeConnection 1 30 10
runAmqp :: (HasAmqpPool m) => (Connection -> Channel -> IO ()) -> m ()
runAmqp action = do
pool <- getAmqpPool
liftIO $ withResource pool $! \conn -> do
chan <- liftIO $ openChannel conn
liftIO $! action conn chan