eventium-memory 0.2.1 → 0.3.0
raw patch · 4 files changed
+91/−32 lines, 4 filesdep +timedep ~eventium-core
Dependencies added: time
Dependency ranges changed: eventium-core
Files
- eventium-memory.cabal +4/−3
- src/Eventium/Store/Memory.hs +9/−9
- tests/Eventium/MetadataEnrichmentSpec.hs +41/−6
- tests/Eventium/ProcessManagerSpec.hs +37/−14
eventium-memory.cabal view
@@ -5,7 +5,7 @@ -- see: https://github.com/sol/hpack name: eventium-memory-version: 0.2.1+version: 0.3.0 synopsis: In-memory implementations for eventium description: Eventium-memory provides in-memory implementations of event stores and projection caches for the Eventium event sourcing framework. This package is ideal for development, testing, and prototyping@@ -49,7 +49,7 @@ build-depends: base >=4.9 && <5 , containers >=0.6 && <0.8- , eventium-core >=0.2.0 && <0.3.0+ , eventium-core >=0.3.0 && <0.4.0 , mtl >=2.2 && <2.4 , safe ==0.3.* , stm ==2.5.*@@ -89,12 +89,13 @@ HUnit , base >=4.9 && <5 , containers >=0.6 && <0.8- , eventium-core >=0.2.0 && <0.3.0+ , eventium-core >=0.3.0 && <0.4.0 , eventium-testkit , hspec , mtl >=2.2 && <2.4 , safe ==0.3.* , stm ==2.5.*+ , time default-language: Haskell2010 if flag(ci) ghc-options: -Werror
src/Eventium/Store/Memory.hs view
@@ -4,15 +4,15 @@ module Eventium.Store.Memory ( tvarEventStoreReader, tvarEventStoreWriter,- tvarEventStoreWriterTagged,+ tvarTaggedEventStoreWriter, tvarGlobalEventStoreReader, stateEventStoreReader, stateEventStoreWriter,- stateEventStoreWriterTagged,+ stateTaggedEventStoreWriter, stateGlobalEventStoreReader, embeddedStateEventStoreReader, embeddedStateEventStoreWriter,- embeddedStateEventStoreWriterTagged,+ embeddedStateTaggedEventStoreWriter, embeddedStateGlobalEventStoreReader, EventMap, emptyEventMap,@@ -66,8 +66,8 @@ -- | Like 'tvarEventStoreWriter' but accepts 'TaggedEvent's, -- preserving the metadata attached to each event.-tvarEventStoreWriterTagged :: TVar (EventMap event) -> VersionedEventStoreWriter STM (TaggedEvent event)-tvarEventStoreWriterTagged tvar = EventStoreWriter $ transactionalExpectedWriteHelper getLatestVersion storeEvents'+tvarTaggedEventStoreWriter :: TVar (EventMap event) -> VersionedEventStoreWriter STM (TaggedEvent event)+tvarTaggedEventStoreWriter tvar = EventStoreWriter $ transactionalExpectedWriteHelper getLatestVersion storeEvents' where getLatestVersion uuid = flip latestEventVersion uuid <$> readTVar tvar storeEvents' uuid events = do@@ -100,10 +100,10 @@ stateEventStoreWriter = embeddedStateEventStoreWriter id (const id) -- | Like 'stateEventStoreWriter' but accepts 'TaggedEvent's.-stateEventStoreWriterTagged ::+stateTaggedEventStoreWriter :: (MonadState (EventMap event) m) => VersionedEventStoreWriter m (TaggedEvent event)-stateEventStoreWriterTagged = embeddedStateEventStoreWriterTagged id (const id)+stateTaggedEventStoreWriter = embeddedStateTaggedEventStoreWriter id (const id) -- | An 'EventStore' that runs on some 'MonadState' that contains an -- 'EventMap'. This is useful if you want to include other state in your@@ -137,12 +137,12 @@ embeddedStateGlobalEventStoreReader getMap = EventStoreReader $ \range -> lookupGlobalEvents range <$> gets getMap -- | Like 'embeddedStateEventStoreWriter' but accepts 'TaggedEvent's.-embeddedStateEventStoreWriterTagged ::+embeddedStateTaggedEventStoreWriter :: (MonadState s m) => (s -> EventMap event) -> (s -> EventMap event -> s) -> VersionedEventStoreWriter m (TaggedEvent event)-embeddedStateEventStoreWriterTagged getMap setMap = EventStoreWriter $ transactionalExpectedWriteHelper getLatestVersion storeEvents'+embeddedStateTaggedEventStoreWriter getMap setMap = EventStoreWriter $ transactionalExpectedWriteHelper getLatestVersion storeEvents' where getLatestVersion uuid = flip latestEventVersion uuid <$> gets getMap storeEvents' uuid events = do
tests/Eventium/MetadataEnrichmentSpec.hs view
@@ -4,7 +4,8 @@ import Control.Concurrent.STM import Data.IORef-import Data.Maybe (isJust)+import Data.Maybe (isJust, isNothing)+import Data.Time (UTCTime (..), fromGregorian) import Eventium import Eventium.Store.Memory import Test.Hspec@@ -14,7 +15,7 @@ describe "metadataEnrichingEventStoreWriter" $ do it "populates event type name from Typeable" $ do tvar <- eventMapTVar- let taggedWriter = tvarEventStoreWriterTagged tvar+ let taggedWriter = tvarTaggedEventStoreWriter tvar enrichedWriter = metadataEnrichingEventStoreWriter testCodec (runEventStoreWriterUsing atomically taggedWriter) reader = runEventStoreReaderUsing atomically (tvarEventStoreReader tvar) uuid = uuidFromInteger 1@@ -24,7 +25,7 @@ it "populates createdAt timestamp" $ do tvar <- eventMapTVar- let taggedWriter = tvarEventStoreWriterTagged tvar+ let taggedWriter = tvarTaggedEventStoreWriter tvar enrichedWriter = metadataEnrichingEventStoreWriter testCodec (runEventStoreWriterUsing atomically taggedWriter) reader = runEventStoreReaderUsing atomically (tvarEventStoreReader tvar) uuid = uuidFromInteger 1@@ -32,6 +33,40 @@ events <- reader.getEvents (allEvents uuid) all (\e -> isJust e.metadata.createdAt) events `shouldBe` True + it "preserves occurredAt when set via enricher" $ do+ tvar <- eventMapTVar+ let taggedWriter = tvarTaggedEventStoreWriter tvar+ enrichedWriter = metadataEnrichingEventStoreWriter testCodec (runEventStoreWriterUsing atomically taggedWriter)+ reader = runEventStoreReaderUsing atomically (tvarEventStoreReader tvar)+ uuid = uuidFromInteger 1+ _ <- enrichedWriter.storeEvents uuid NoStream [42 :: Int]+ events <- reader.getEvents (allEvents uuid)+ -- occurredAt should be Nothing by default (auto-enrichment doesn't set it)+ all (\e -> isNothing e.metadata.occurredAt) events `shouldBe` True++ describe "metadataEnrichingEventStoreWriterWithEnricher" $ do+ it "applies MetadataEnricher to set occurredAt" $ do+ tvar <- eventMapTVar+ let pastTime = UTCTime (fromGregorian 2025 3 15) 0+ enricher m = m {occurredAt = Just pastTime}+ taggedWriter = tvarTaggedEventStoreWriter tvar+ enrichedWriter = metadataEnrichingEventStoreWriterWithEnricher enricher testCodec (runEventStoreWriterUsing atomically taggedWriter)+ reader = runEventStoreReaderUsing atomically (tvarEventStoreReader tvar)+ uuid = uuidFromInteger 1+ _ <- enrichedWriter.storeEvents uuid NoStream [42 :: Int]+ events <- reader.getEvents (allEvents uuid)+ map (\e -> e.metadata.occurredAt) events `shouldBe` [Just pastTime]++ it "id enricher leaves occurredAt as Nothing" $ do+ tvar <- eventMapTVar+ let taggedWriter = tvarTaggedEventStoreWriter tvar+ enrichedWriter = metadataEnrichingEventStoreWriterWithEnricher id testCodec (runEventStoreWriterUsing atomically taggedWriter)+ reader = runEventStoreReaderUsing atomically (tvarEventStoreReader tvar)+ uuid = uuidFromInteger 1+ _ <- enrichedWriter.storeEvents uuid NoStream [42 :: Int]+ events <- reader.getEvents (allEvents uuid)+ map (\e -> e.metadata.occurredAt) events `shouldBe` [Nothing]+ describe "backward compatibility" $ do it "non-tagged writer still uses empty metadata" $ do tvar <- eventMapTVar@@ -42,15 +77,15 @@ events <- reader.getEvents (allEvents uuid) map (\e -> e.metadata.eventType) events `shouldBe` [""] - describe "publishingEventStoreWriterTagged" $ do+ describe "publishingTaggedCodecEventStoreWriter" $ do it "propagates metadata to published StreamEvents" $ do tvar <- eventMapTVar publishedRef <- newIORef []- let taggedWriter = runEventStoreWriterUsing atomically (tvarEventStoreWriterTagged tvar)+ let taggedWriter = runEventStoreWriterUsing atomically (tvarTaggedEventStoreWriter tvar) handler = EventHandler $ \(StreamEvent _ _ meta _) -> modifyIORef publishedRef (++ [meta.eventType]) publisher = synchronousPublisher handler- pubWriter = publishingEventStoreWriterTagged taggedWriter publisher+ pubWriter = publishingTaggedCodecEventStoreWriter testCodec taggedWriter publisher enrichedWriter = metadataEnrichingEventStoreWriter testCodec pubWriter uuid = uuidFromInteger 1 _ <- enrichedWriter.storeEvents uuid NoStream [42 :: Int, 99]
tests/Eventium/ProcessManagerSpec.hs view
@@ -3,6 +3,7 @@ module Eventium.ProcessManagerSpec (spec) where import Data.IORef+import Data.Time (UTCTime (..), fromGregorian) import Eventium.ProcessManager import Eventium.Projection import Eventium.Store.Class@@ -33,9 +34,9 @@ handleEvent st _ = st reactFn _st (StreamEvent _ _ _ (TransferInitiated target amount)) =- [IssueCommand target (AcceptCredit amount)]+ [IssueCommand target (AcceptCredit amount) id] reactFn _st (StreamEvent sourceId _ _ (Credited _)) =- [IssueCommand sourceId (AcceptCredit 0)]+ [IssueCommand sourceId (AcceptCredit 0) id] spec :: Spec spec = do@@ -44,13 +45,13 @@ let target = uuidFromInteger 2 event = StreamEvent (uuidFromInteger 1) 0 (emptyMetadata "") (TransferInitiated target 50) effects = testProcessManager.react (PMState []) event- effects `shouldBe` [IssueCommand target (AcceptCredit 50)]+ effects `shouldBe` [IssueCommand target (AcceptCredit 50) id] it "should produce IssueCommand for credit events" $ do let source = uuidFromInteger 1 event = StreamEvent source 0 (emptyMetadata "") (Credited 100) effects = testProcessManager.react (PMState []) event- effects `shouldBe` [IssueCommand source (AcceptCredit 0)]+ effects `shouldBe` [IssueCommand source (AcceptCredit 0) id] it "should return empty list for unmatched events" $ do -- Events that don't match any pattern in react@@ -78,7 +79,7 @@ let dispatcher = fireAndForgetDispatcher $ \uuid cmd -> modifyIORef dispatchedRef (++ [(uuid, cmd)]) let target = uuidFromInteger 2- effects = [IssueCommand target (AcceptCredit 50)]+ effects = [IssueCommand target (AcceptCredit 50) id] runProcessManagerEffects dispatcher effects @@ -92,9 +93,9 @@ let target1 = uuidFromInteger 1 target2 = uuidFromInteger 2 effects =- [ IssueCommand target1 (AcceptCredit 50),- IssueCommand target2 (AcceptCredit 100),- IssueCommand target1 (AcceptCredit 25)+ [ IssueCommand target1 (AcceptCredit 50) id,+ IssueCommand target2 (AcceptCredit 100) id,+ IssueCommand target1 (AcceptCredit 25) id ] runProcessManagerEffects dispatcher effects@@ -108,12 +109,12 @@ it "should dispatch commands via CommandDispatcher" $ do dispatchedRef <- newIORef ([] :: [(UUID, TestCommand)])- let dispatcher = mkCommandDispatcher $ \uuid cmd -> do+ let dispatcher = mkCommandDispatcher $ \uuid cmd _enricher -> do modifyIORef dispatchedRef (++ [(uuid, cmd)]) pure CommandSucceeded let target = uuidFromInteger 2- effects = [IssueCommand target (AcceptCredit 50)]+ effects = [IssueCommand target (AcceptCredit 50) id] runProcessManagerEffects dispatcher effects @@ -124,7 +125,7 @@ dispatchedRef <- newIORef ([] :: [(UUID, TestCommand)]) let target1 = uuidFromInteger 1 target2 = uuidFromInteger 2- dispatcher = mkCommandDispatcher $ \uuid cmd -> do+ dispatcher = mkCommandDispatcher $ \uuid cmd _enricher -> do modifyIORef dispatchedRef (++ [(uuid, cmd)]) if uuid == target1 then pure (CommandFailed "rejected")@@ -134,7 +135,8 @@ [ IssueCommandWithCompensation target1 (AcceptCredit 50)- (const [IssueCommand target2 (AcceptCredit 0)])+ id+ (const [IssueCommand target2 (AcceptCredit 0) id]) ] runProcessManagerEffects dispatcher effects@@ -146,7 +148,7 @@ dispatchedRef <- newIORef ([] :: [(UUID, TestCommand)]) let target1 = uuidFromInteger 1 target2 = uuidFromInteger 2- dispatcher = mkCommandDispatcher $ \uuid cmd -> do+ dispatcher = mkCommandDispatcher $ \uuid cmd _enricher -> do modifyIORef dispatchedRef (++ [(uuid, cmd)]) pure CommandSucceeded @@ -154,10 +156,31 @@ [ IssueCommandWithCompensation target1 (AcceptCredit 50)- (const [IssueCommand target2 (AcceptCredit 0)])+ id+ (const [IssueCommand target2 (AcceptCredit 0) id]) ] runProcessManagerEffects dispatcher effects dispatched <- readIORef dispatchedRef dispatched `shouldBe` [(target1, AcceptCredit 50)]++ it "should thread MetadataEnricher from IssueCommand to dispatch" $ do+ dispatchedRef <- newIORef ([] :: [(UUID, TestCommand, MetadataEnricher)])+ let dispatcher = CommandDispatcher $ \uuid cmd enricher -> do+ modifyIORef dispatchedRef (++ [(uuid, cmd, enricher)])+ pure CommandSucceeded++ let target = uuidFromInteger 2+ enricher m = m {occurredAt = Just (UTCTime (fromGregorian 2025 3 15) 0)}+ effects = [IssueCommand target (AcceptCredit 50) enricher]++ runProcessManagerEffects dispatcher effects++ dispatched <- readIORef dispatchedRef+ case dispatched of+ [(_, cmd, enr)] -> do+ cmd `shouldBe` AcceptCredit 50+ let enriched = enr (emptyMetadata "test")+ enriched.occurredAt `shouldBe` Just (UTCTime (fromGregorian 2025 3 15) 0)+ _ -> expectationFailure "expected exactly one dispatch"