{-# 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 :: HList '[TmpRabbitMQ]
aProc = TmpRabbitMQ
TmpRabbitMQ TmpRabbitMQ -> HList '[] -> HList '[TmpRabbitMQ]
forall anyTy (manyTys :: [*]).
anyTy -> HList manyTys -> HList (anyTy : manyTys)
`HCons` HList '[]
HNil


{-| 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 = Proxy AMQPException -> IO Connection -> IO Pinged
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 (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"


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