eventium-memory-0.2.1: tests/Eventium/CommandHandlerSpec.hs
module Eventium.CommandHandlerSpec (spec) where
import Control.Concurrent.STM
import Control.Exception (evaluate)
import Eventium.Codec (Codec (..), DecodeError (..))
import Eventium.CommandHandler
import Eventium.Projection
import Eventium.Store.Class
import Eventium.Store.Memory
import Eventium.Testkit (allCommandHandlerStates)
import Eventium.UUID
import Test.Hspec
-- Helper to create IO-compatible stores from a TVar
makeIOStore :: TVar (EventMap event) -> (VersionedEventStoreWriter IO event, VersionedEventStoreReader IO event)
makeIOStore tvar =
( runEventStoreWriterUsing atomically (tvarEventStoreWriter tvar),
runEventStoreReaderUsing atomically (tvarEventStoreReader tvar)
)
-- Simple counter domain for testing
data CounterError = Overflow | Underflow
deriving (Show, Eq)
type CounterHandler = CommandHandler Int Int Int CounterError
counterHandler :: CounterHandler
counterHandler = CommandHandler decide counterProj
where
counterProj = Projection 0 (+)
decide state cmd
| state + cmd > 100 = Left Overflow
| state + cmd < 0 = Left Underflow
| otherwise = Right [cmd]
spec :: Spec
spec = do
describe "allCommandHandlerStates" $ do
it "should advance state on accepted commands" $ do
allCommandHandlerStates counterHandler [10, 20, 30]
`shouldBe` [0, 10, 30, 60]
it "should leave state unchanged on rejected commands" $ do
allCommandHandlerStates counterHandler [50, 60, 10]
`shouldBe` [0, 50, 50, 60]
-- 60 is rejected (50+60>100), state stays at 50
it "should handle mixed accept/reject" $ do
allCommandHandlerStates counterHandler [30, -50, 20, 80]
`shouldBe` [0, 30, 30, 50, 50]
-- -50 rejected (30-50<0), 80 rejected (50+80>100)
describe "applyCommandHandler" $ do
it "should return Right events on success" $ do
tvar <- eventMapTVar
let (writer, reader) = makeIOStore tvar
uuid = uuidFromInteger 1
result <- applyCommandHandler writer reader counterHandler uuid 10
result `shouldBe` Right [10]
-- Verify events are stored
events <- reader.getEvents (allEvents uuid)
map (.payload) events `shouldBe` [10]
it "should return CommandRejected on domain error" $ do
tvar <- eventMapTVar
let (writer, reader) = makeIOStore tvar
uuid = uuidFromInteger 1
result <- applyCommandHandler writer reader counterHandler uuid 150
result `shouldBe` Left (CommandRejected Overflow)
-- Verify no events stored
events <- reader.getEvents (allEvents uuid)
events `shouldBe` []
it "should return ConcurrencyConflict on write failure" $ do
tvar <- eventMapTVar
let (_, reader) = makeIOStore tvar
-- Use a writer that always fails to simulate concurrency conflict
let failWriter = EventStoreWriter $ \_ _ _ ->
return $ Left (EventStreamNotAtExpectedVersion (42 :: EventVersion))
result <- applyCommandHandler failWriter reader counterHandler (uuidFromInteger 1) 5
result `shouldBe` Left (ConcurrencyConflict (EventStreamNotAtExpectedVersion 42))
it "should apply multiple commands sequentially" $ do
tvar <- eventMapTVar
let (writer, reader) = makeIOStore tvar
uuid = uuidFromInteger 1
result1 <- applyCommandHandler writer reader counterHandler uuid 30
result1 `shouldBe` Right [30]
result2 <- applyCommandHandler writer reader counterHandler uuid 40
result2 `shouldBe` Right [40]
-- Third command should be rejected (30+40+50=120 > 100)
result3 <- applyCommandHandler writer reader counterHandler uuid 50
result3 `shouldBe` Left (CommandRejected Overflow)
-- Verify only two events stored
events <- reader.getEvents (allEvents uuid)
map (.payload) events `shouldBe` [30, 40]
describe "codecCommandHandler" $ do
it "should map through codecs on success" $ do
let eventCodec = Codec show (Just . read)
cmdCodec = Codec show (Just . read)
wrapped = codecCommandHandler eventCodec cmdCodec counterHandler
wrapped.decide 0 "10" `shouldBe` Right ["10"]
it "should error when command decoding fails" $ do
let eventCodec = Codec show (Just . read)
cmdCodec = Codec (show :: Int -> String) (\_ -> Nothing :: Maybe Int)
wrapped = codecCommandHandler eventCodec cmdCodec counterHandler
evaluate (wrapped.decide 0 "anything") `shouldThrow` (\(DecodeError ctx _) -> ctx == "codecCommandHandler")
it "should propagate domain errors through codec" $ do
let eventCodec = Codec show (Just . read)
cmdCodec = Codec show (Just . read)
wrapped = codecCommandHandler eventCodec cmdCodec counterHandler
wrapped.decide 0 "150" `shouldBe` Left Overflow