eventsource-store-specs 1.1.1 → 1.2.0

raw patch · 5 files changed

+56/−203 lines, 5 filesdep +streamingdep ~eventsource-apiPVP ok

version bump matches the API change (PVP)

Dependencies added: streaming

Dependency ranges changed: eventsource-api

API changes (from Hackage documentation)

Files

• CHANGELOG.md +5/−0
• README.md +1/−2
• eventsource-store-specs.cabal +12/−16
• library/Test/EventSource/Store/Specification.hs +34/−182
• package.yaml +4/−3

@@ -1,3 +1,8 @@+1.2.0+=====+    * Migrate to `eventsource-api` 1.5.0.+    * Remove Aggregate API specifications.+ 1.1.1 =====     * Fix aggregate specifications.

@@ -1,5 +1,4 @@-# [eventsource-store-specs][]+# eventsource-store-specs  This project provides an open store specification, as a HUnit test, for store implementors. The goal is to make sure every `Store` implementation behaves the same regarding to those tests.-[eventsource-store-specs]: https://github.com/YoEight/eventsource-api

@@ -1,34 +1,33 @@--- This file has been generated from package.yaml by hpack version 0.20.0.+cabal-version: 1.12++-- This file has been generated from package.yaml by hpack version 0.31.1. -- -- see: https://github.com/sol/hpack ----- hash: d777dc8703aa877ee92bbe9d587eb15fc8c2b4e7e2a858fca62afb9305f35b67+-- hash: 9c8c101db53eaf1abae04a422e8fc481e8be4f1eb98149cbc6861a6020ea8343  name:           eventsource-store-specs-version:        1.1.1+version:        1.2.0 synopsis:       Provides common test specification for Store implementation. description:    Provides common test specification for Store implementation. category:       Eventsourcing, Testing-homepage:       https://github.com/YoEight/eventsource-api#readme-bug-reports:    https://github.com/YoEight/eventsource-api/issues+homepage:       https://gitlab.com/YoEight/eventsource-api-hs author:         Yorick Laupa maintainer:     yo.eight@gmail.com license:        BSD3 license-file:   LICENSE.md build-type:     Simple-cabal-version:  >= 1.10- extra-source-files:     CHANGELOG.md     LICENSE.md     package.yaml     README.md -source-repository head-  type: git-  location: https://github.com/YoEight/eventsource-api- library+  exposed-modules:+      Test.EventSource.Store.Specification+  other-modules:+      Paths_eventsource_store_specs   hs-source-dirs:       library   ghc-options: -Wall@@ -36,15 +35,12 @@       aeson     , async     , base >=4.9 && <5-    , eventsource-api ==1.*+    , eventsource-api >=1.5     , mtl+    , streaming     , tasty     , tasty-hspec     , text     , transformers-base     , uuid-  exposed-modules:-      Test.EventSource.Store.Specification-  other-modules:-      Paths_eventsource_store_specs   default-language: Haskell2010

@@ -17,23 +17,20 @@ module Test.EventSource.Store.Specification (specification) where  ---------------------------------------------------------------------------------import Control.Exception (Exception, toException, fromException)+import Control.Exception (Exception, throwIO) import Control.Monad (unless)-import Data.Foldable (for_, traverse_)-import Data.Semigroup ((<>))+import Data.Foldable (for_)  -------------------------------------------------------------------------------- import           Control.Concurrent.Async (wait)-import           Control.Monad.Except (runExceptT, mapExceptT) import           Control.Monad.Base (MonadBase, liftBase)-import           Control.Monad.State (evalStateT, get, modify) import           Data.Aeson.Types (object, withObject, (.=), (.:)) import           Data.Text (Text) import           Data.UUID (toText) import           Data.UUID.V4 (nextRandom) import           EventSource-import           EventSource.Aggregate (StreamId(..))-import qualified EventSource.Aggregate.Simple as Simple+import           Streaming (Stream, Of)+import qualified Streaming.Prelude as Streaming import           Test.Tasty.Hspec  --------------------------------------------------------------------------------@@ -58,41 +55,37 @@ newtype Test = Test Int deriving (Eq, Show)  ---------------------------------------------------------------------------------data TestCmd-  = TestIncr Int-  | TestCmdError---------------------------------------------------------------------------------- data TestError = TestError deriving (Eq, Show)  -------------------------------------------------------------------------------- instance Exception TestError  ---------------------------------------------------------------------------------newtype TestId = TestId Text-----------------------------------------------------------------------------------instance StreamId TestId where-  toStreamName (TestId i) = StreamName $ "test:stream:" <> i-----------------------------------------------------------------------------------instance Simple.AggregateIO TestEvent Test where-  applyIO (Test x) (TestEvent i) = pure (Test (x+i))+freshStreamName :: MonadBase IO m => m StreamName+freshStreamName = liftBase $ fmap (StreamName . toText) nextRandom  ---------------------------------------------------------------------------------instance Simple.ValidateIO TestCmd TestEvent Test where-  validateIO _ cmd =-    case cmd of-      TestIncr i   -> pure (Right $ TestEvent i)-      TestCmdError -> pure (Left $ toException TestError)+defaultBatch :: Batch+defaultBatch =+  Batch'+  { batchFrom = 0+  , batchSize = 1+  }  ---------------------------------------------------------------------------------freshStreamName :: MonadBase IO m => m StreamName-freshStreamName = liftBase $ fmap (StreamName . toText) nextRandom+decodeAs :: (Traversable t, DecodeEvent a) => t SavedEvent -> Either Text (t a)+decodeAs = traverse (decodeEvent . savedEvent)  ---------------------------------------------------------------------------------incr :: Int -> Int-incr = (+1)+streamDecodeAs :: DecodeEvent a+               => Stream (Of SavedEvent) IO ()+               -> Stream (Of a) IO ()+streamDecodeAs = Streaming.mapM go+  where+    go e =+      case decodeEvent (savedEvent e) of+        Left _  -> throwIO TestError+        Right a -> pure a  -------------------------------------------------------------------------------- specification :: Store store => store -> Spec@@ -101,29 +94,24 @@     let expected = TestEvent 1     name <- freshStreamName     _ <- wait =<< appendEvent store name AnyVersion expected-    res <- wait =<< readBatch store name (startFrom 0)--    res `shouldSatisfy` isReadSuccess-    let ReadSuccess slice = res+    let stream = unhandled $ readStream store name defaultBatch -    for_ (zip [0..] $ sliceEvents slice) $ \(num, e) ->+    evts <- Streaming.toList_ stream+    for_ (zip [0..] evts) $ \(num, e) ->       eventNumber e `shouldBe` num -    sliceEventsAs slice `shouldBe` Right [expected]+    decodeAs evts `shouldBe` Right [expected]    specify "API - Read events in batch" $ do     let expected = fmap TestEvent [1..3]     name <- freshStreamName     _ <- wait =<< appendEvents store name AnyVersion                          expected-    res <- streamIterator store name--    res `shouldSatisfy` isReadSuccess+    let stream = unhandled $ readStream store name defaultBatch -    let ReadSuccess i = res-    got <- iteratorReadAllEvents i+    got <- Streaming.toList_ stream -    got `shouldBe` expected+    decodeAs got `shouldBe` Right expected    specify "API - Subscription working" $ do     let expected = TestEvent 1@@ -132,145 +120,9 @@      _ <- wait =<< appendEvent store name AnyVersion expected -    res <- nextEventAs sub-    res `shouldSatisfy` either (const False) (const True)+    let stream = Streaming.take 1+                           $ streamDecodeAs+                           $ subscriptionStream sub -    let Right got = res+    [got] <- Streaming.toList_ stream     got `shouldBe` expected--  specify "API - forEvents" $ do-    let events = fmap TestEvent [0..9]-    name <- freshStreamName-    _ <- wait =<< appendEvents store name AnyVersion events--    let action = do-          forEvents store name $ \(_ :: TestEvent) ->-            modify incr-          get--    res <- runExceptT $ mapExceptT (\m -> evalStateT m 0) action--    res `shouldSatisfy` either (const False) (const True)-    let Right st = res--    st `shouldBe` (10 :: Int)--  specify "API - foldEvents" $ do-    let events = fmap TestEvent [0..9]-    name <- freshStreamName-    _ <- wait =<< appendEvents store name AnyVersion events--    res <- runExceptT $ foldEvents store name-                      (\s (_ :: TestEvent) -> s + 1)-                      0--    res `shouldSatisfy` either (const False) (const True)-    let Right st = res--    st `shouldBe` (10 :: Int)--  specify "API - forSavedEvents" $ do-    let events = fmap TestEvent [0..9]-    name <- freshStreamName-    _ <- wait =<< appendEvents store name AnyVersion events--    let action = do-          forSavedEvents store name $ \(_ :: SavedEvent) -> modify incr-          get--    res <- runExceptT $ mapExceptT (\m -> evalStateT m 0) action--    res `shouldSatisfy` either (const False) (const True)-    let Right st = res--    st `shouldBe` (10 :: Int)--  specify "API - foldSavedEvents" $ do-    let values = [0..9]-        events = fmap TestEvent values-        seed   = Right (0, EventNumber 0)--        testFold (Left e) _           = Left e-        testFold (Right (a, n)) saved =-          let n' = eventNumber saved-              ee = decodeEvent $ savedEvent saved in-          case ee of-            Left t               -> Left t-            Right (TestEvent a') -> Right (a + a', max n n')--    name <- freshStreamName-    _ <- wait =<< appendEvents store name AnyVersion events--    res <- runExceptT $ foldSavedEvents store name testFold seed--    res `shouldSatisfy` either (const False) (const True)-    let Right st = res--    st `shouldBe` Right (sum values, EventNumber 9)--  specify "API - Iterator.readAllEvents" $ do-    let events = fmap TestEvent [0..9]-    name <- freshStreamName-    _ <- wait =<< appendEvents store name AnyVersion events--    res <- streamIterator store name-    res `shouldSatisfy` isReadSuccess-    let ReadSuccess i = res--    got <- iteratorReadAllEvents i-    got `shouldBe` events--  specify "API/Aggregate - submit event" $ do-    StreamName name <- freshStreamName-    agg <- Simple.newAgg (toStore store) (TestId name) (Test 0)-    let events = replicate 10 (TestEvent 1)--    traverse_ (Simple.submitEvt agg) events-    got <- Simple.snapshot agg--    got `shouldBe` Test 10--  specify "API/Aggregate - submit commands" $ do-    StreamName name <- freshStreamName-    agg <- Simple.newAgg (toStore store) (TestId name) (Test 0)--    res1 <- Simple.submitCmd agg (TestIncr 1)-    let go1 (Right evt) = evt == TestEvent 1-        go1 Left{}      = False-    res1 `shouldSatisfy` go1--    s1 <- Simple.snapshot agg-    s1 `shouldBe` Test 1--    res2 <- Simple.submitCmd agg TestCmdError-    let go2 Right{}  = False-        go2 (Left e) = fromException e == Just TestError-    res2 `shouldSatisfy` go2--  specify "API/Aggregate - loading" $ do-    StreamName name <- freshStreamName-    agg1 <- Simple.newAgg (toStore store) (TestId name) (Test 0)--    let commands = replicate 10 (TestIncr 1)--    traverse_ (Simple.submitCmd agg1) commands--    res1 <- Simple.snapshot agg1-    res1 `shouldBe` Test 10--    outcome <- Simple.loadAgg (toStore store) (TestId name) (Test 0)--    case outcome of-      Left{}     -> error "We should be able to load an aggregate."-      Right agg2 ->-        do res2 <- Simple.snapshot agg2-           res2 `shouldBe` res1--           res3 <- Simple.submitCmd agg2 (TestIncr 1)-           let go3 Left{} = False-               go3 Right{} = True-           res3 `shouldSatisfy` go3--           res4 <- Simple.snapshot agg2-           res4 `shouldBe` Test 11-

@@ -9,11 +9,11 @@ - package.yaml - README.md ghc-options: -Wall-github: YoEight/eventsource-api+homepage: https://gitlab.com/YoEight/eventsource-api-hs library:   dependencies:   - base >=4.9 && <5-  - eventsource-api ==1.*+  - eventsource-api >=1.5   - tasty   - tasty-hspec   - mtl@@ -22,6 +22,7 @@   - async   - transformers-base   - text+  - streaming   source-dirs: library license: BSD3 license-file: LICENSE.md@@ -29,4 +30,4 @@ maintainer: yo.eight@gmail.com name: eventsource-store-specs synopsis: Provides common test specification for Store implementation.-version: '1.1.1'+version: '1.2.0'