componentm-0.0.0.0: test/tasty/ComponentTest.hs
{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
module ComponentTest where
import Control.Exception (ErrorCall (..), MaskingState (..),
getMaskingState)
import RIO
import Test.Tasty (TestTree, testGroup)
import Test.Tasty.HUnit
import qualified Control.Monad.Component as SUT
import Control.Teardown (toredownCount)
tests :: TestTree
tests = testGroup
"ComponentM"
[ testGroup
"Async Exceptions"
[ testCase "it releases previously allocated resources" $ do
callCountRef <- newIORef (0 :: Int)
let alloc = do
modifyIORef callCountRef (+ 1)
return ()
release = const $ return ()
componentOne = SUT.buildComponent "one" alloc release
componentTwo = SUT.buildComponent "two" alloc release
componentThree = SUT.buildComponent_ "three" (threadDelay 10100100)
componentAction = do
componentOne
componentTwo
componentThree
resultAsync <- async $ SUT.runComponentM "test application"
componentAction
(const $ return ())
threadDelay 500
cancel resultAsync
result <- waitCatch resultAsync
case result of
Left _err -> do
callCount <- readIORef callCountRef
assertEqual "teardown action got called more than once" 2 callCount
Right _ -> assertFailure "expecting failure; got success instead"
]
, testGroup
"Sync Exceptions"
[ testCase "it releases previously allocated resources" $ do
callCountRef <- newIORef (0 :: Int)
let
alloc = do
modifyIORef callCountRef (+ 1)
return ()
release = const $ return ()
componentOne = SUT.buildComponent "one" alloc release
componentTwo = SUT.buildComponent "two" alloc release
componentThree = SUT.buildComponent
"three"
(throwIO (ErrorCall "failing three"))
release
componentFour =
SUT.buildComponent_ "four" (throwIO $ ErrorCall "failing four")
componentAction = do
componentOne
void componentTwo
void componentThree
componentFour
result <- try $ SUT.runComponentM "test application"
componentAction
(const $ return ())
case result of
Left (SUT.ComponentBuildFailed _appErr teardownResult) -> do
callCount <- readIORef callCountRef
assertEqual "got more than one two valid components" 2 callCount
-- 1. component one
-- 2. component two
-- 3. allocated component three (notice, error happens once allocation is done)
assertEqual "There should be three toredown resources"
3
(toredownCount teardownResult)
_ ->
assertFailure $ "expected error, but did not happen, " <> show result
, testCase "component construction allows throwM calls" $ do
callCountRef <- newIORef (0 :: Int)
let alloc = do
modifyIORef callCountRef (+ 1)
return ()
release = const $ return ()
componentOne = SUT.buildComponent "one" alloc release
componentTwo = SUT.buildComponent "two" alloc release
componentAction = do
componentOne
void $ throwM (ErrorCall "failing via MonadThrow")
componentTwo
result <- try
$ SUT.runComponentM "test application" componentAction return
case result of
Left (SUT.ComponentBuildFailed [SUT.ComponentErrorThrown err] _teardownResult)
-> do
callCount <- readIORef callCountRef
assertEqual "expected introduced error, got different one"
(Just $ ErrorCall "failing via MonadThrow")
(fromException err)
assertEqual "teardown action got called more than once" 1 callCount
Left err ->
assertFailure
$ "expected ComponentStartupFailure exception, got instead: "
<> show err
Right _ -> assertFailure "expected error, but did not happen"
]
, testGroup
"Masking"
[ testCase "app callback is _always_ on unmasked state" $ do
maskingVar <- newEmptyMVar
let alloc = return ()
release _ = getMaskingState >>= putMVar maskingVar
componentOne = SUT.buildComponent "one" alloc release
SUT.runComponentM "app" componentOne return
masking <- takeMVar maskingVar
assertEqual "App callback is always in unmasked state"
MaskedUninterruptible
masking
]
, testGroup
"Duplicate component names"
[ testCase "fails with an exception" $ do
callCountRef <- newIORef (0 :: Int)
let alloc = do
modifyIORef callCountRef (+ 1)
return ()
release = const $ return ()
componentOne = SUT.buildComponent "one" alloc release
componentTwo = SUT.buildComponent "two" alloc release
componentThree = SUT.buildComponent_ "three" (return ())
componentAction = do
componentOne
void componentTwo
void componentThree
void componentThree
result <- try $ SUT.runComponentM "test application"
componentAction
(const $ return ())
case result of
Left (SUT.ComponentBuildFailed appErr teardownResult) -> do
callCount <- readIORef callCountRef
case appErr of
[SUT.DuplicatedComponentKeyDetected componentName] -> assertEqual
"should report duplicated component name"
"three"
componentName
_ ->
assertFailure
$ "expecting single component build error error; got: "
<> show appErr
assertEqual "got more than one two valid components" 2 callCount
-- 1. component one
-- 2. component two
-- 3. allocated component three (notice, error happens once allocation is done)
assertEqual "There should be three toredown resources"
3
(toredownCount teardownResult)
_ -> assertFailure "expected error, but did not happen"
]
, testGroup
"Monad"
[ testCase "aggregates multiple component teardown values" $ do
callCountRef <- newIORef (0 :: Int)
let alloc = do
modifyIORef callCountRef (+ 1)
return ()
release = const $ return ()
componentOne = SUT.buildComponent "one" alloc release
componentTwo = SUT.buildComponent "two" alloc release
componentThree = SUT.buildComponent_ "three" $ return ()
componentAction = do
componentOne
componentTwo
componentThree
_result <- SUT.runComponentM "test application"
componentAction
(const $ return ())
callCount <- readIORef callCountRef
assertEqual "teardown action got called more than once" 2 callCount
, testCase "initializes components sequentially on the same thread" $ do
let componentOne = SUT.buildComponent_ "one" myThreadId
componentTwo = SUT.buildComponent_ "two" myThreadId
componentThree = SUT.buildComponent_ "three" myThreadId
componentAction = do
t1 <- componentOne
t2 <- componentTwo
t3 <- componentThree
return (t1, t2, t3)
(t1, t2, t3) <- SUT.runComponentM "test application"
componentAction
return
assertBool "expecting t1 to be equal to t2" (t1 == t2)
assertBool "expecting t2 to be equal to t3" (t2 == t3)
]
, testGroup
"Applicative"
[ testCase "reports multiple failures" $ do
callCountRef <- newIORef (0 :: Int)
let
alloc = do
modifyIORef callCountRef (+ 1)
return ()
release = const $ return ()
componentOne = SUT.buildComponent "one" alloc release
componentTwo =
SUT.buildComponent_ "two" $ throwIO (ErrorCall "failing two")
componentThree = SUT.buildComponent
"three"
(throwIO (ErrorCall "failing three"))
release
componentAction = componentOne *> componentTwo *> componentThree
result <- try
$ SUT.runComponentM "test application" componentAction return
case result of
Left (SUT.ComponentBuildFailed [SUT.ComponentAllocationFailed _desc2 err2, SUT.ComponentAllocationFailed _desc3 err3] _teardownResult)
-> do
assertEqual "expected introduced error, got different one"
(Just $ ErrorCall "failing two")
(fromException err2)
assertEqual "expected introduced error, got different one"
(Just $ ErrorCall "failing three")
(fromException err3)
callCount <- readIORef callCountRef
assertEqual "teardown action got called more than once" 1 callCount
Left err ->
assertFailure
$ "expected ComponentStartupFailure exception with two errors, got instead: "
<> show err
Right _ -> assertFailure "expected error, but did not happen"
, testCase "initializes components concurrently" $ do
let
componentOne = SUT.buildComponent_ "one" myThreadId
componentTwo = SUT.buildComponent_ "two" myThreadId
componentThree = SUT.buildComponent_ "three" myThreadId
componentAction =
(,,) <$> componentOne <*> componentTwo <*> componentThree
(t1, t2, t3) <- SUT.runComponentM "test application"
componentAction
return
assertBool "expecting t1 to be different than t2" (t1 /= t2)
assertBool "expecting t2 to be different than t3" (t2 /= t3)
assertBool "expecting t1 to be different than t3" (t1 /= t3)
]
, testGroup
"MonadIO"
[ testCase "wraps IO exceptions with info" $ do
callCountRef <- newIORef (0 :: Int)
let alloc = return ()
release = const $ do
modifyIORef callCountRef (+ 1)
return ()
componentOne = SUT.buildComponent "one" alloc release
componentTwo = SUT.buildComponent_ "two" $ return ()
componentAction = do
componentOne
void $ liftIO $ throwIO (ErrorCall "failing on liftIO")
componentTwo
result <- try
$ SUT.runComponentM "test application" componentAction return
case result of
Left (SUT.ComponentBuildFailed [SUT.ComponentIOLiftFailed ex] teardownResult)
-> do
releaseCount <- readIORef callCountRef
assertEqual
"should have called the release of component one, but didn't"
1
releaseCount
assertEqual
"should have called the release of component one, but didn't"
1
(toredownCount teardownResult)
assertEqual "should have reported the liftIO error, but didn't"
(Just $ ErrorCall "failing on liftIO")
(fromException ex)
_ ->
assertFailure
$ "expecting to get component build failed error, got instead: "
<> show result
]
]