diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,3 +1,8 @@ +1.2.0 +===== + * Migrate to `eventsource-api` 1.5.0. + * Remove Aggregate API specifications. + 1.1.1 ===== * Fix aggregate specifications. diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -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 diff --git a/eventsource-store-specs.cabal b/eventsource-store-specs.cabal --- a/eventsource-store-specs.cabal +++ b/eventsource-store-specs.cabal @@ -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 diff --git a/library/Test/EventSource/Store/Specification.hs b/library/Test/EventSource/Store/Specification.hs --- a/library/Test/EventSource/Store/Specification.hs +++ b/library/Test/EventSource/Store/Specification.hs @@ -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 - diff --git a/package.yaml b/package.yaml --- a/package.yaml +++ b/package.yaml @@ -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'