RabbitMQ.hs

{-# LANGUAGE DataKinds             #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE NamedFieldPuns        #-}
{-# LANGUAGE OverloadedStrings     #-}
{-# LANGUAGE TypeApplications      #-}
{-# LANGUAGE TypeFamilies          #-}
{-# OPTIONS_HADDOCK prune not-home #-}
{-|
Copyright   : (c) 2020-2021 Tim Emiola
SPDX-License-Identifier: BSD3
Maintainer  : Tim Emiola <adetokunbo@users.noreply.github.com >

Provides an instance of 'Proc' that launches @RabbitMQ@ as a @tmp proc@.

The instance this module provides can be used in integration tests as is.

It's also possible to write other instances that launch @RabbitMQ@ in different
ways; for those, this instance can be used as a reference example.

-}
module System.TmpProc.Docker.RabbitMQ
  ( -- * 'Proc' instance
    TmpRabbitMQ(..)

    -- * Useful definitions
  , aProc
  , aHandle

    -- * Re-exports
  , module System.TmpProc
  )
where

import qualified Data.ByteString.Char8 as C8
import           Data.Proxy            (Proxy(..))
import qualified Data.Text             as Text

import           Network.AMQP

import           System.TmpProc        (Connectable (..), HList (..), HandlesOf,
                                        HostIpAddress, Proc (..),
                                        ProcHandle (..), SvcURI, startupAll,
                                        toPinged, withTmpConn)


{-| A singleton 'HList' containing a 'TmpRabbitMQ'. -}
aProc :: HList '[TmpRabbitMQ]
aProc = TmpRabbitMQ `HCons` HNil


{-| An 'HList' that just contains the handle created by 'aProc'. -}
aHandle :: IO (HandlesOf '[TmpRabbitMQ])
aHandle = startupAll aProc


{-| Provides the capability to launch a RabbitMQ instance as a @tmp proc@. -}
data TmpRabbitMQ = TmpRabbitMQ


{-| Specifies how to run @RabbitMQ@ as a @tmp proc@. -}
instance Proc TmpRabbitMQ where
  type Image TmpRabbitMQ = "rabbitmq:3.9"
  type Name TmpRabbitMQ = "a-rabbitmq-server"

  uriOf = mkUri'
  runArgs = []
  ping = toPinged @AMQPException Proxy . openConn'
  reset _ = pure ()
  pingGap = 3 * 1000000


{-| Specifies how to connect to a tmp @RabbitMQ@ service. -}
instance Connectable TmpRabbitMQ where
  type Conn TmpRabbitMQ = Connection

  openConn = openConn'
  closeConn = closeConnection


{-| Makes a uri using the guest password . -}
mkUri' :: HostIpAddress -> SvcURI
mkUri' ip =
  "amqp://guest:guest@"
  <> C8.pack (Text.unpack ip)
  <> ":5672@/%2f"


openConn' :: ProcHandle TmpRabbitMQ -> IO Connection
openConn' = openConnection'' . fromURI . C8.unpack . hUri