Skip to content

A snaplet providing a convenience interface to the Haskell AMQP package.

License

Notifications You must be signed in to change notification settings

ixmatus/snaplet-amqp

Repository files navigation

Welcome!

https://img.shields.io/hackage/v/snaplet-amqp.svg?style=flat https://travis-ci.org/ixmatus/snaplet-amqp.svg?branch=master

snaplet-amqp provides a convenience interface to the Haskell AMQP package.

Because the AMQP package doesn’t provide its own connection pooling mechanism, this snaplet uses the resource-pool package to create a pool of ten connections (only connections, not channels).

When the runAmqp function is used a connection from the pool is leased, a channel is created and both the connection and channel are applied to the supplied action.

{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards   #-}
{-# LANGUAGE TemplateHaskell   #-}

module Main where

------------------------------------------------------------------------------
import           Control.Lens
import           Data.ByteString.Char8 as C8
import           Network.AMQP
import           Snap
import           Snap.Snaplet.AMQP

------------------------------------------------------------------------------
data App = App
    { _amqp :: Snaplet AmqpState
    }

makeLenses ''App

instance HasAmqpPool (Handler b App) where
    getAmqpPool = with amqp getAmqpPool

------------------------------------------------------------------------------
-- | The application's routes.
routes :: [(ByteString, Handler App App ())]
routes = [ ("/"   , writeText "hello")
         , ("test", fooHandler)
         ]

fooHandler :: Handler App App ()
fooHandler = do
    let serverQueue = "myQueue"
        exchange'   = "myExchange"
        routingKey  = "myKey"

    _ <- runAmqp $ \chan -> do
        _ <- declareQueue chan newQueue {queueName = serverQueue}

        declareExchange chan newExchange { exchangeName = exchange'
                                         , exchangeType = "headers"
                                         }
        bindQueue chan serverQueue exchange' routingKey

        publishMsg chan exchange' routingKey
            newMsg {msgBody = "AMQP Snaplet!",
                    msgDeliveryMode = Just Persistent}

    modifyResponse $ setResponseCode 204


------------------------------------------------------------------------------
-- | The application initializer.
app :: SnapletInit App App
app = makeSnaplet "app" "An snaplet example application." Nothing $ do
    m <- nestSnaplet "amqp" amqp $ initAMQP
    addRoutes routes
    return $ App m

main :: IO ()
main = serveSnaplet defaultConfig app

About

A snaplet providing a convenience interface to the Haskell AMQP package.

Resources

License

Stars

Watchers

Forks

Packages

No packages published