module Eventful.TestHelpers
( Counter (..)
, CounterProjection
, counterProjection
, CounterAggregate
, counterAggregate
, CounterEvent (..)
, CounterCommand (..)
, eventStoreSpec
, sequencedEventStoreSpec
, module X
) where
import Control.Monad as X
import Control.Monad.IO.Class as X
import Control.Monad.Logger as X
import Data.Aeson
import Data.Aeson.Casing
import Data.Aeson.TH
import Test.Hspec
import Eventful
newtype Counter = Counter { unCounter :: Int }
deriving (Eq, Show, FromJSON, ToJSON)
data CounterEvent
= Added
{ _counterEventAmount :: Int
}
| CounterFailedOutOfBounds
deriving (Eq, Show)
type CounterProjection = Projection Counter CounterEvent
counterProjection :: CounterProjection
counterProjection =
Projection
(Counter 0)
(\(Counter k) (Added x) -> Counter (k + x))
data CounterCommand
= Increment
{ _counterCommandAmount :: Int
}
| Decrement
{ _counterCommandAmount :: Int
}
deriving (Eq, Show)
type CounterAggregate = Aggregate Counter CounterEvent CounterCommand
counterAggregate :: CounterAggregate
counterAggregate = Aggregate counterCommand counterProjection
counterCommand :: Counter -> CounterCommand -> [CounterEvent]
counterCommand (Counter k) (Increment n) =
if k + n <= 100
then [Added n]
else [CounterFailedOutOfBounds]
counterCommand (Counter k) (Decrement n) =
if k n >= 0
then [Added (n)]
else [CounterFailedOutOfBounds]
deriveJSON (aesonPrefix camelCase) ''CounterEvent
deriveJSON (aesonPrefix camelCase) ''CounterCommand
eventStoreSpec
:: (Monad m)
=> IO (EventStore CounterEvent m, runargs)
-> (forall a. runargs -> m a -> IO a)
-> Spec
eventStoreSpec makeStore runAsIO = do
context "when the event store is empty" $ do
it "should return versions of -1 for a UUID" $ do
(store, runargs) <- liftIO makeStore
runAsIO runargs (getLatestVersion store nil) `shouldReturn` (1)
context "when a few events are inserted" $ do
let
events = [Added 1, Added 4, Added (3)]
buildStore = do
(store, runargs) <- liftIO makeStore
_ <- liftIO . runAsIO runargs $ storeEvents store NoStream nil events
return (store, runargs)
it "should return events" $ do
(store, runargs) <- liftIO buildStore
events' <- runAsIO runargs (getEvents store nil Nothing)
(storedEventEvent <$> events') `shouldBe` events
it "should return correct event versions" $ do
(store, runargs) <- liftIO buildStore
runAsIO runargs (getLatestVersion store nil) `shouldReturn` 2
runAsIO runargs (fmap storedEventEvent <$> getEvents store nil (Just (1)))
>>= (`shouldBe` events)
runAsIO runargs (fmap storedEventEvent <$> getEvents store nil (Just 1))
>>= (`shouldBe` drop 1 events)
it "should return the latest projection" $ do
(store, runargs) <- liftIO buildStore
runAsIO runargs (getLatestProjection store counterProjection nil)
`shouldReturn` (Counter 2, 2)
context "when events from multiple UUIDs are inserted" $ do
let
buildStore = do
(store, runargs) <- liftIO makeStore
_ <- liftIO . runAsIO runargs $ insertExampleEvents store
return (store, runargs)
it "should have the correct events for each aggregate" $ do
(store, runargs) <- liftIO buildStore
events1 <- runAsIO runargs (getEvents store uuid1 Nothing)
events2 <- runAsIO runargs (getEvents store uuid2 Nothing)
(storedEventEvent <$> events1) `shouldBe` Added <$> [1, 4]
(storedEventEvent <$> events2) `shouldBe` Added <$> [2, 3, 5]
(storedEventProjectionId <$> events1) `shouldBe` [uuid1, uuid1]
(storedEventProjectionId <$> events2) `shouldBe` [uuid2, uuid2, uuid2]
(storedEventVersion <$> events1) `shouldBe` [0, 1]
(storedEventVersion <$> events2) `shouldBe` [0, 1, 2]
it "should return correct event versions" $ do
(store, runargs) <- liftIO buildStore
runAsIO runargs (getLatestVersion store uuid1) `shouldReturn` 1
runAsIO runargs (getLatestVersion store uuid2) `shouldReturn` 2
events1 <- runAsIO runargs (getEvents store uuid1 (Just 0))
events2 <- runAsIO runargs (getEvents store uuid2 (Just 1))
storedEventEvent <$> events1 `shouldBe` [Added 1, Added 4]
storedEventEvent <$> events2 `shouldBe` [Added 3, Added 5]
it "should produce the correct projections" $ do
(store, runargs) <- liftIO buildStore
runAsIO runargs (getLatestProjection store counterProjection uuid1)
`shouldReturn` (Counter 5, 1)
runAsIO runargs (getLatestProjection store counterProjection uuid2)
`shouldReturn` (Counter 10, 2)
describe "can handle event storage errors" $ do
it "rejects some writes when event store isn't created" $ do
(store, runargs) <- liftIO makeStore
runAsIO runargs (storeEvents store StreamExists nil [Added 1])
`shouldReturn` Just (EventStreamNotAtExpectedVersion (1))
runAsIO runargs (storeEvents store (ExactVersion 0) nil [Added 1])
`shouldReturn` Just (EventStreamNotAtExpectedVersion (1))
it "should be able to store events starting with an empty stream" $ do
(store, runargs) <- liftIO makeStore
runAsIO runargs (storeEvents store NoStream nil [Added 1]) `shouldReturn` Nothing
it "should reject storing events sometimes with a stream" $ do
(store, runargs) <- liftIO makeStore
runAsIO runargs (storeEvents store NoStream nil [Added 1]) `shouldReturn` Nothing
runAsIO runargs (storeEvents store NoStream nil [Added 1])
`shouldReturn` Just (EventStreamNotAtExpectedVersion 0)
runAsIO runargs (storeEvents store (ExactVersion 1) nil [Added 1])
`shouldReturn` Just (EventStreamNotAtExpectedVersion 0)
it "should accepts storing events sometimes with a stream" $ do
(store, runargs) <- liftIO makeStore
runAsIO runargs (storeEvents store NoStream nil [Added 1]) `shouldReturn` Nothing
runAsIO runargs (storeEvents store AnyVersion nil [Added 1]) `shouldReturn` Nothing
runAsIO runargs (storeEvents store (ExactVersion 1) nil [Added 1]) `shouldReturn` Nothing
runAsIO runargs (storeEvents store StreamExists nil [Added 1]) `shouldReturn` Nothing
sequencedEventStoreSpec
:: (Monad m)
=> IO (EventStore CounterEvent m, GloballyOrderedEventStore CounterEvent m, runargs)
-> (forall a. runargs -> m a -> IO a)
-> Spec
sequencedEventStoreSpec makeStore runAsIO = do
context "when the event store is empty" $ do
it "shouldn't have any events" $ do
(_, globalStore, runargs) <- liftIO makeStore
length <$> runAsIO runargs (getSequencedEvents globalStore 0) `shouldReturn` 0
context "when events from multiple UUIDs are inserted" $ do
let
buildStore = do
(store, globalStore, runargs) <- liftIO makeStore
_ <- liftIO . runAsIO runargs $ insertExampleEvents store
return (globalStore, runargs)
it "should have the correct events in global order" $ do
(store, runargs) <- liftIO buildStore
events' <- runAsIO runargs $ getSequencedEvents store 0
(storedEventEvent . globallyOrderedEventEvent <$> events') `shouldBe` Added <$> [1..5]
(storedEventProjectionId . globallyOrderedEventEvent <$> events') `shouldBe` [uuid1, uuid2, uuid2, uuid1, uuid2]
(storedEventVersion . globallyOrderedEventEvent <$> events') `shouldBe` [0, 0, 1, 1, 2]
(globallyOrderedEventSequenceNumber <$> events') `shouldBe` [1..5]
insertExampleEvents
:: (Monad m)
=> EventStore CounterEvent m
-> m ()
insertExampleEvents store = do
void $ storeEvents store NoStream uuid1 [Added 1]
void $ storeEvents store NoStream uuid2 [Added 2, Added 3]
void $ storeEvents store (ExactVersion 0) uuid1 [Added 4]
void $ storeEvents store (ExactVersion 1) uuid2 [Added 5]
uuid1 :: UUID
uuid1 = uuidFromInteger 1
uuid2 :: UUID
uuid2 = uuidFromInteger 2