eventful-test-helpers (empty) → 0.1.0

raw patch · 3 files changed

+270/−0 lines, 3 filesdep +aesondep +aeson-casingdep +base

Dependencies added: aeson, aeson-casing, base, eventful-core, extra, hspec, monad-logger

Files

• LICENSE.md +19/−0
• eventful-test-helpers.cabal +32/−0
• src/Eventful/TestHelpers.hs +219/−0

@@ -0,0 +1,19 @@+Copyright (c) 2016-2017 David Reaver++Permission is hereby granted, free of charge, to any person obtaining a copy of+this software and associated documentation files (the "Software"), to deal in+the Software without restriction, including without limitation the rights to+use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies+of the Software, and to permit persons to whom the Software is furnished to do+so, subject to the following conditions:++The above copyright notice and this permission notice shall be included in all+copies or substantial portions of the Software.++THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR+IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,+FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE+AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER+LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,+OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE+SOFTWARE.

@@ -0,0 +1,32 @@+-- This file has been generated from package.yaml by hpack version 0.17.0.+--+-- see: https://github.com/sol/hpack++name:           eventful-test-helpers+version:        0.1.0+synopsis:       Common module used for eventful tests+description:    Common module used for eventful tests+category:       Database,Eventsourcing+stability:      experimental+maintainer:     David Reaver+license:        MIT+license-file:   LICENSE.md+build-type:     Simple+cabal-version:  >= 1.10++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+    , eventful-core+    , aeson+    , aeson-casing+    , extra+    , hspec+    , monad-logger+  exposed-modules:+      Eventful.TestHelpers+  default-language: Haskell2010

@@ -0,0 +1,219 @@+-- | Common test functionality++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++-- | Example Projection/Aggregate+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++-- Test harness for stores++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+      -- TODO: Abstract out creating all of these stores and having to manually+      -- thread around makeStore, runAsIO, etc.+      (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+      --(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)++    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