diff --git a/eventium-memory.cabal b/eventium-memory.cabal --- a/eventium-memory.cabal +++ b/eventium-memory.cabal @@ -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 diff --git a/src/Eventium/Store/Memory.hs b/src/Eventium/Store/Memory.hs --- a/src/Eventium/Store/Memory.hs +++ b/src/Eventium/Store/Memory.hs @@ -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 diff --git a/tests/Eventium/MetadataEnrichmentSpec.hs b/tests/Eventium/MetadataEnrichmentSpec.hs --- a/tests/Eventium/MetadataEnrichmentSpec.hs +++ b/tests/Eventium/MetadataEnrichmentSpec.hs @@ -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] diff --git a/tests/Eventium/ProcessManagerSpec.hs b/tests/Eventium/ProcessManagerSpec.hs --- a/tests/Eventium/ProcessManagerSpec.hs +++ b/tests/Eventium/ProcessManagerSpec.hs @@ -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"