hats-0.1.0.0: test/ReconnectionTests.hs

{-# LANGUAGE OverloadedStrings #-}
module ReconnectionTests
    ( subscribeAndReconnect
    , connectionGiveUp
    , authorizationFail
    , authorizationSuccess
    ) where

import Control.Concurrent
import Control.Exception
import Control.Monad (when)
import Data.Maybe (isNothing)
import System.Timeout (timeout)
import Test.HUnit

import Gnatsd
import Network.Nats

-- | Subscribe to three topics. Take down the current NATS connection,
-- force a reconnection, publish to the topics and test that the
-- messages are received.
subscribeAndReconnect :: Assertion
subscribeAndReconnect = do
    connect <- newEmptyMVar
    let settings = defaultSettings
                       { connectedTo = connected connect
                       }
    g1 <- startGnatsd
    withNats settings [defaultURI] $ \nats -> do

        -- Ok, just wait for the first connect.
        c1 <- timeout oneSec $ takeMVar connect
        when (isNothing c1) $ do
            stopGnatsd g1
            assertFailure "Shall have connected :-("

        -- Subscribe to three topics.
        (_, queue1) <- subscribe nats "topic1" Nothing
        (_, queue2) <- subscribe nats "topic2" Nothing
        (_, queue3) <- subscribe nats "topic3" Nothing

        -- Let things have the time to go on network.
        threadDelay 100000

        -- Take down gnatsd.
        stopGnatsd g1

        -- Start a new instance.
        g2 <- startGnatsd

        -- Publish to the topics.
        publish nats "topic1" Nothing "payload1"
        publish nats "topic2" Nothing "payload2"
        publish nats "topic3" Nothing "payload3"

        m1 <- timeout oneSec $ nextMsg queue1
        when (isNothing m1) $ do
            stopGnatsd g2
            assertFailure "Shall have received a message (m1)"

        m2 <- timeout oneSec $ nextMsg queue2
        when (isNothing m2) $ do
            stopGnatsd g2
            assertFailure "Shall have received a message (m2)"

        m3 <- timeout oneSec $ nextMsg queue3
        when (isNothing m3) $ do
            stopGnatsd g2
            assertFailure "Shall have received a message (m3)"

        -- Survived this far? Success, but terminate gnatsd before quitting.
        stopGnatsd g2

connected :: MVar () -> SockAddr -> IO ()
connected sync _ = putMVar sync ()

-- | Test that when the reconnection logic gives up, a
-- ConnectionGiveUpException is thrown out of the withNats function.
connectionGiveUp :: Assertion
connectionGiveUp =
    (\ConnectionGiveUpException -> return ()) `handle` do
        withNats defaultSettings [defaultURI] $ \_ ->
            threadDelay oneSec

        assertFailure "Shall never come here!"

-- | Try to connect a server to which the test don't have the
-- credentials. Shall get a AuthorizationException.
authorizationFail :: Assertion
authorizationFail = withGnatsdUP authorizationFail'

authorizationFail' :: Assertion
authorizationFail' =
    (\AuthorizationException -> return ()) `handle` do
        withNats defaultSettings [defaultURI] $ \_ ->
            threadDelay oneSec

        assertFailure "Shall never come here!"

-- | Connect to a server with credentials. Shall work, no
-- exceptions thrown.
authorizationSuccess :: Assertion
authorizationSuccess = withGnatsdUP authorizationSuccess'

authorizationSuccess' :: Assertion
authorizationSuccess' =
    withNats defaultSettings [userPasswordURI] $ \_ ->
        threadDelay oneSec

oneSec :: Int
oneSec = 1000000