module Data.CQRS.Test.Internal.RepositoryTest
( mkRepositorySpec
) where
import Control.DeepSeq (NFData)
import Control.Monad (forM_, liftM)
import Control.Monad.Trans.Reader (ask)
import Control.Monad.IO.Class (liftIO)
import Data.ByteString (ByteString)
import qualified Data.ByteString.Char8 as B8
import qualified Data.ByteString as B
import Data.CQRS.Command (CommandT)
import qualified Data.CQRS.Command as C
import Data.CQRS.Query
import Data.CQRS.Repository
import Data.CQRS.Types.EventStore (EventStore)
import Data.CQRS.Types.SnapshotStore (nullSnapshotStore, SnapshotStore)
import Data.CQRS.Test.Internal.AggregateAction (byteStringAggregateAction)
import Data.CQRS.Test.Internal.Scope (ScopeM, verify, randomUUID, mkRunScope)
import Data.CQRS.Test.Internal.TestKitSettings
import Data.IORef (IORef, newIORef, readIORef, atomicModifyIORef')
import Data.Maybe (fromJust)
import Data.UUID.Types (UUID)
import qualified System.Random as R
import qualified Test.Hspec as Hspec
import Test.Hspec (Spec, shouldBe)
import Test.HUnit (assertBool)
data Scope a e = Scope { scopeRepository :: Repository a e
, scopePublishedEvents :: IORef [(UUID, e, Int)]
}
assertDidPublish :: (Show e, Eq e) => [(UUID, e, Int)] -> ScopeM (Scope a e) ()
assertDidPublish expectedEvents = do
publishedEventsRef <- fmap scopePublishedEvents $ ask
verify $ do
publishedEvents <- readIORef publishedEventsRef
length publishedEvents `shouldBe` length expectedEvents
forM_ (zip publishedEvents expectedEvents) $ uncurry shouldBe
getRepository :: ScopeM (Scope a e) (Repository a e)
getRepository = fmap scopeRepository ask
runCommandT :: CommandT a e IO r -> ScopeM (Scope a e) r
runCommandT command = do
repository <- getRepository
liftIO $ C.runCommandT repository command
mkRunScope' :: Int -> TestKitSettings s (EventStore ByteString, SnapshotStore ByteString) -> (ScopeM (Scope ByteString ByteString) r -> IO r)
mkRunScope' snapshotFrequency testKitSettings = mkRunScope testKitSettings $ \a -> do
publishedEventsRef <- newIORef []
let publish (aggregateId, events') = atomicModifyIORef' publishedEventsRef $ \events ->
(events ++ map (\(PersistedEvent e s _) -> (aggregateId, e, s)) events', ())
(eventStore, snapshotStore) <- (tksMakeContext testKitSettings) a
let settings = setSnapshotFrequency snapshotFrequency $ defaultSettings
let repository = newRepository settings byteStringAggregateAction eventStore snapshotStore publish R.randomIO
return $ Scope repository publishedEventsRef
mkRepositorySpec :: TestKitSettings a (EventStore ByteString, SnapshotStore ByteString) -> Spec
mkRepositorySpec testKitSettings = do
forM_ [ 3, 5 ] $ \f -> do
let fs = "frequency " ++ show f
let s1 = "(snapshots; " ++ fs ++ ")"
let s2 = "(null snapshots; " ++ fs ++ ")"
mkSpec s1 (mkRunScope' f $ testKitSettings)
mkSpec s2 (mkRunScope' f $ disableSnapshots testKitSettings)
where
disableSnapshots settings =
settings { tksMakeContext = \a -> do
(eventStore, _) <- tksMakeContext settings a
return (eventStore, nullSnapshotStore)
}
mkSpec :: String -> (ScopeM (Scope ByteString ByteString) () -> IO ()) -> Spec
mkSpec suffix runScope = do
describe "Repository" $ do
it "should support creating an aggregate and returning its value" $ do
(aggregateId, a) <- newAggregate ["3"]
verify $ a `shouldBe` "3"
assertDidPublish [ (aggregateId, "3", 0) ]
it "should support creating an aggregate and loading it" $ do
(aggregateId, _) <- newAggregate ["4"]
a <- loadAggregate aggregateId
verify $ a `shouldBe` "4"
assertDidPublish [ (aggregateId, "4", 0) ]
it "should support publishing >1 events to an aggregate (1 txn)" $ do
(aggregateId, _) <- newAggregate ["7", "1"]
a <- loadAggregate aggregateId
verify $ a `shouldBe` "71"
assertDidPublish [ (aggregateId, "7", 0)
, (aggregateId, "1", 1)
]
it "should support publishing >1 events to an aggregate (2 txns)" $ do
(aggregateId, _) <- newAggregate ["9"]
_ <- runCommandT $ do
C.updateAggregate aggregateId $ \_ -> do
C.publishEvent $ "7"
a <- loadAggregate aggregateId
verify $ a `shouldBe` "97"
assertDidPublish [ (aggregateId, "9", 0)
, (aggregateId, "7", 1)
]
it "should support publishing a large number of events to an aggregate" $ do
let events = map B8.pack $ map show ([1.. 100] :: [Int])
(aggregateId, _) <- newAggregate events
a <- loadAggregate aggregateId
verify $ a `shouldBe` B.concat events
it "should be possible to find an existing aggregate" $ do
(aggregateId, _) <- newAggregate ["xyzzy"]
a <- findAggregate aggregateId
verify $ a `shouldBe` Just "xyzzy"
it "should not be possible to find a non-existent aggregate" $ do
aggregateId <- randomUUID
a <- findAggregate aggregateId
verify $ a `shouldBe` Nothing
it "should be possible to work with two different aggregates (serially) in a command" $ do
aggregateId0 <- randomUUID
aggregateId1 <- randomUUID
_ <- runCommandT $ do
C.createAggregate aggregateId0 $ \_ -> do
C.publishEvent "34"
C.createAggregate aggregateId1 $ \_ -> do
C.publishEvent "1"
C.updateAggregate aggregateId0 $ \_ -> do
C.publishEvent "5"
a0 <- loadAggregate aggregateId0
a1 <- loadAggregate aggregateId1
verify $ a0 `shouldBe` "345"
verify $ a1 `shouldBe` "1"
assertDidPublish [ (aggregateId0, "34", 0)
, (aggregateId1, "1", 0)
, (aggregateId0, "5", 1)
]
it "'getter' function returns up-to-date values when updating an aggregate" $ do
(aggregateId, _) <- newAggregate ["x"]
Just (a, a') <- runCommandT $ do
C.updateAggregate aggregateId $ \get -> do
a <- get
C.publishEvent "y"
a' <- get
return (a, a')
verify $ a `shouldBe` "x"
verify $ a' `shouldBe` "xy"
assertDidPublish [ (aggregateId, "x", 0)
, (aggregateId, "y", 1)
]
it "'getter' function returns up-to-date values when creating an aggregate" $ do
aggregateId <- randomUUID
(a, a') <- runCommandT $ do
C.createAggregate aggregateId $ \get -> do
a <- get
C.publishEvent "x"
a' <- get
return (a, a')
verify $ a `shouldBe` Nothing
verify $ a' `shouldBe` (Just "x")
assertDidPublish [ (aggregateId, "x", 0) ]
where
it msg scope = Hspec.it msg $ runScope scope
describe msg = Hspec.describe (msg ++ " " ++ suffix)
newAggregate :: (NFData a, NFData e) => [e] -> ScopeM (Scope a e) (UUID, a)
newAggregate es = do
aggregateId <- randomUUID
liftIO $ assertBool "List of initial events must be non-emtpy" (length es > 0)
runCommandT $ do
a <- C.createAggregate aggregateId $ \getAggregate -> do
forM_ es $ C.publishEvent
liftM fromJust $ getAggregate
return (aggregateId, a)
loadAggregate :: UUID -> ScopeM (Scope a e) a
loadAggregate aggregateId = liftM get $ runCommandT $ C.readAggregate aggregateId
where
get Nothing = error $ "loadAggregate: Missing expected aggregate"
get (Just a) = a
findAggregate :: UUID -> ScopeM (Scope a e) (Maybe a)
findAggregate = do
runCommandT . (flip C.updateAggregate) id