{-# LANGUAGE DataKinds #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# 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 Control.Exception (throwIO)
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
  , only
  , startupAll
  , toPinged
  , withTmpConn
  )


-- | A singleton 'HList' containing a 'TmpRabbitMQ'.
aProc :: HList '[TmpRabbitMQ]
aProc :: HList '[TmpRabbitMQ]
aProc = TmpRabbitMQ -> HList '[TmpRabbitMQ]
forall x. x -> HList '[x]
only TmpRabbitMQ
TmpRabbitMQ


-- | An 'HList' that just contains the handle created by 'aProc'.
aHandle :: IO (HandlesOf '[TmpRabbitMQ])
aHandle :: IO (HandlesOf '[TmpRabbitMQ])
aHandle = HList '[TmpRabbitMQ] -> IO (HandlesOf '[TmpRabbitMQ])
forall (procs :: [*]).
AreProcs procs =>
HList procs -> IO (HandlesOf procs)
startupAll HList '[TmpRabbitMQ]
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 :: Text -> SvcURI
uriOf = Text -> SvcURI
mkUri'
  runArgs :: [Text]
runArgs = []
  ping :: ProcHandle TmpRabbitMQ -> IO Pinged
ping = forall e a. Exception e => Proxy e -> IO a -> IO Pinged
toPinged @AMQPException Proxy AMQPException
forall {k} (t :: k). Proxy t
Proxy (IO Connection -> IO Pinged)
-> (ProcHandle TmpRabbitMQ -> IO Connection)
-> ProcHandle TmpRabbitMQ
-> IO Pinged
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ProcHandle TmpRabbitMQ -> IO Connection
openConn'
  reset :: ProcHandle TmpRabbitMQ -> IO ()
reset ProcHandle TmpRabbitMQ
_ = () -> IO ()
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
  pingGap :: Natural
pingGap = Natural
3 Natural -> Natural -> Natural
forall a. Num a => a -> a -> a
* Natural
1000000


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


  openConn :: ProcHandle TmpRabbitMQ -> IO (Conn TmpRabbitMQ)
openConn = ProcHandle TmpRabbitMQ -> IO Connection
ProcHandle TmpRabbitMQ -> IO (Conn TmpRabbitMQ)
openConn'
  closeConn :: Conn TmpRabbitMQ -> IO ()
closeConn = Connection -> IO ()
Conn TmpRabbitMQ -> IO ()
closeConnection


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


fromURI' :: String -> IO ConnectionOpts
fromURI' :: String -> IO ConnectionOpts
fromURI' String
x = case String -> Either String ConnectionOpts
fromURI String
x of
  Left String
e -> IOError -> IO ConnectionOpts
forall e a. Exception e => e -> IO a
throwIO (IOError -> IO ConnectionOpts) -> IOError -> IO ConnectionOpts
forall a b. (a -> b) -> a -> b
$ String -> IOError
userError String
e
  Right ConnectionOpts
c -> ConnectionOpts -> IO ConnectionOpts
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ConnectionOpts
c


openConn' :: ProcHandle TmpRabbitMQ -> IO Connection
openConn' :: ProcHandle TmpRabbitMQ -> IO Connection
openConn' ProcHandle TmpRabbitMQ
h = do
  ConnectionOpts
opts <- String -> IO ConnectionOpts
fromURI' (String -> IO ConnectionOpts) -> String -> IO ConnectionOpts
forall a b. (a -> b) -> a -> b
$ SvcURI -> String
C8.unpack (SvcURI -> String) -> SvcURI -> String
forall a b. (a -> b) -> a -> b
$ ProcHandle TmpRabbitMQ -> SvcURI
forall a. ProcHandle a -> SvcURI
hUri ProcHandle TmpRabbitMQ
h
  ConnectionOpts -> IO Connection
openConnection'' ConnectionOpts
opts