{-# 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
  , 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"


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