diff --git a/eventful-test-helpers.cabal b/eventful-test-helpers.cabal --- a/eventful-test-helpers.cabal +++ b/eventful-test-helpers.cabal @@ -3,7 +3,7 @@ -- see: https://github.com/sol/hpack name: eventful-test-helpers -version: 0.1.1 +version: 0.1.2 synopsis: Common module used for eventful tests description: Common module used for eventful tests category: Database,Eventsourcing @@ -23,7 +23,6 @@ library hs-source-dirs: src - default-extensions: ConstraintKinds DeriveFunctor DeriveGeneric FlexibleContexts FlexibleInstances FunctionalDependencies GADTs GeneralizedNewtypeDeriving MultiParamTypeClasses OverloadedStrings QuasiQuotes RankNTypes RecordWildCards ScopedTypeVariables StandaloneDeriving TemplateHaskell TupleSections TypeFamilies ghc-options: -Wall build-depends: base >= 4.9 && < 5 diff --git a/src/Eventful/TestHelpers.hs b/src/Eventful/TestHelpers.hs --- a/src/Eventful/TestHelpers.hs +++ b/src/Eventful/TestHelpers.hs @@ -1,3 +1,7 @@ +{-# LANGUAGE GeneralizedNewtypeDeriving #-} +{-# LANGUAGE RankNTypes #-} +{-# LANGUAGE TemplateHaskell #-} + -- | Common test functionality module Eventful.TestHelpers @@ -89,41 +93,41 @@ 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) + (store, runargs) <- makeStore + events' <- runAsIO runargs $ do + _ <- storeEvents store NoStream nil events + getEvents store nil Nothing (storedEventEvent <$> events') `shouldBe` events --(storedEventSequenceNumber <$> events') `shouldBe` [1, 2, 3] 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) + (store, runargs) <- makeStore + (latestVersion, allEvents, someEvents) <- runAsIO runargs $ do + _ <- storeEvents store NoStream nil events + (,,) <$> + getLatestVersion store nil <*> + getEvents store nil (Just (-1)) <*> + getEvents store nil (Just 1) + latestVersion `shouldBe` 2 + (storedEventEvent <$> allEvents) `shouldBe` events + (storedEventEvent <$> someEvents) `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) + (store, runargs) <- makeStore + projection <- runAsIO runargs $ do + _ <- storeEvents store NoStream nil events + getLatestProjection store counterProjection nil + projection `shouldBe` (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) + (store, runargs) <- makeStore + (events1, events2) <- runAsIO runargs $ do + _ <- insertExampleEvents store + (,) <$> getEvents store uuid1 Nothing <*> getEvents store uuid2 Nothing (storedEventEvent <$> events1) `shouldBe` Added <$> [1, 4] (storedEventEvent <$> events2) `shouldBe` Added <$> [2, 3, 5] (storedEventProjectionId <$> events1) `shouldBe` [uuid1, uuid1] @@ -132,48 +136,65 @@ (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)) + (store, runargs) <- makeStore + (latestVersion1, latestVersion2, events1, events2) <- runAsIO runargs $ do + _ <- insertExampleEvents store + (,,,) <$> + getLatestVersion store uuid1 <*> + getLatestVersion store uuid2 <*> + getEvents store uuid1 (Just 0) <*> + getEvents store uuid2 (Just 1) + latestVersion1 `shouldBe` 1 + latestVersion2 `shouldBe` 2 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) + (store, runargs) <- makeStore + (proj1, proj2) <- runAsIO runargs $ do + _ <- insertExampleEvents store + (,) <$> + getLatestProjection store counterProjection uuid1 <*> + getLatestProjection store counterProjection uuid2 + proj1 `shouldBe` (Counter 5, 1) + proj2 `shouldBe` (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)) + (store, runargs) <- makeStore + (err1, err2) <- runAsIO runargs $ + (,) <$> + storeEvents store StreamExists nil [Added 1] <*> + storeEvents store (ExactVersion 0) nil [Added 1] + err1 `shouldBe` Just (EventStreamNotAtExpectedVersion (-1)) + err2 `shouldBe` Just (EventStreamNotAtExpectedVersion (-1)) it "should be able to store events starting with an empty stream" $ do - (store, runargs) <- liftIO makeStore + (store, runargs) <- 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) + (store, runargs) <- makeStore + (err1, err2, err3) <- runAsIO runargs $ + (,,) <$> + storeEvents store NoStream nil [Added 1] <*> + storeEvents store NoStream nil [Added 1] <*> + storeEvents store (ExactVersion 1) nil [Added 1] + err1 `shouldBe` Nothing + err2 `shouldBe` Just (EventStreamNotAtExpectedVersion 0) + err3 `shouldBe` 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 + (store, runargs) <- makeStore + errors <- runAsIO runargs $ + sequence + [ storeEvents store NoStream nil [Added 1] + , storeEvents store AnyVersion nil [Added 1] + , storeEvents store (ExactVersion 1) nil [Added 1] + , storeEvents store StreamExists nil [Added 1] + ] + errors `shouldBe` [Nothing, Nothing, Nothing, Nothing] sequencedEventStoreSpec :: (Monad m) @@ -184,22 +205,19 @@ context "when the event store is empty" $ do it "shouldn't have any events" $ do - (_, globalStore, runargs) <- liftIO makeStore + (_, globalStore, runargs) <- 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] + (store, globalStore, runargs) <- makeStore + events' <- runAsIO runargs $ do + insertExampleEvents store + getSequencedEvents globalStore 0 + (globallyOrderedEventEvent <$> events') `shouldBe` Added <$> [1..5] + (globallyOrderedEventProjectionId <$> events') `shouldBe` [uuid1, uuid2, uuid2, uuid1, uuid2] + (globallyOrderedEventVersion <$> events') `shouldBe` [0, 0, 1, 1, 2] (globallyOrderedEventSequenceNumber <$> events') `shouldBe` [1..5] insertExampleEvents