diff --git a/eventium-core.cabal b/eventium-core.cabal --- a/eventium-core.cabal +++ b/eventium-core.cabal @@ -5,7 +5,7 @@ -- see: https://github.com/sol/hpack name: eventium-core -version: 0.5.0 +version: 0.5.2 synopsis: Core module for eventium description: Eventium-core provides the core abstractions and utilities for building event sourcing systems in Haskell. It includes event store interfaces, command handlers, projections, event handlers, event publishers, @@ -49,6 +49,8 @@ Eventium.ProjectionCache.Types Eventium.ReadModel Eventium.SchemaEvolution + Eventium.SchemaEvolution.Json + Eventium.SchemaEvolution.Types Eventium.Store.Class Eventium.Store.Queries Eventium.Store.Types @@ -109,6 +111,8 @@ Eventium.ProjectionCache.Types Eventium.ReadModel Eventium.SchemaEvolution + Eventium.SchemaEvolution.Json + Eventium.SchemaEvolution.Types Eventium.Store.Class Eventium.Store.Queries Eventium.Store.Types diff --git a/src/Eventium/SchemaEvolution.hs b/src/Eventium/SchemaEvolution.hs --- a/src/Eventium/SchemaEvolution.hs +++ b/src/Eventium/SchemaEvolution.hs @@ -1,5 +1,3 @@ -{-# LANGUAGE OverloadedStrings #-} - -- | Event schema evolution via upcast-on-read against an immutable log. -- -- Stored events are never mutated. Instead, when an event type's shape changes @@ -9,204 +7,50 @@ -- version-independent, and supports version-skipping (restoring an -- N-releases-old backup) simply by running more hops. -- --- == Envelope --- --- Serialized payloads are wrapped in a versioned envelope: +-- This module is the entry point; it re-exports: -- --- > { "schemaVersion": N, "payload": } +-- * "Eventium.SchemaEvolution.Types" — the representation-agnostic __core__: +-- 'SchemaRegistry', 'registerUpcasters', 'currentVersion', and 'upcast', +-- parametric in a document representation @d@ ('Upcaster' @d = d -> d@). +-- The chaining, versioning, and version-skipping logic live here. +-- * "Eventium.SchemaEvolution.Json" — the JSON __instance__ over Aeson @Value@: +-- the versioned envelope, the field combinators ('atKey', 'addFieldIfAbsent', +-- …), and 'upcastingValueCodec'. -- --- Events written before this envelope existed lack the top-level --- @schemaVersion@ key and are defined to be @schemaVersion = 1@ by convention; --- their whole stored value is the payload. Existing rows are never rewritten. +-- Import a submodule directly to limit scope; import this module for both. -- -- == Registry -- --- A 'SchemaRegistry' maps an event-type name to an ordered list of single-hop +-- A 'SchemaRegistry' maps an 'EventTypeName' to an ordered list of single-hop -- upcasters @[v1->v2, v2->v3, ...]@. The current version of a type is -- @1 + number of hops@, so the two can never drift. A type with no registered --- upcasters is at version 1 and decodes with no transformation. +-- upcasters is at version 1 and 'upcast's to itself. -- --- == Codec +-- == Envelope -- --- 'upcastingValueCodec' is a drop-in 'Codec' between a domain event type and --- its stored 'Value'. It is parameterized by an @eventTypeOf@ function that --- reads the type name from a payload (the caller's tagging convention), which --- keeps this module agnostic to how any particular app tags its events. Because --- it is a plain 'Codec', it serves both synchronous (in-transaction) and --- asynchronous (polling) consumers, and every event type and backend, with no --- reader-level plumbing. +-- Serialized JSON payloads are wrapped in a versioned envelope +-- @{ "schemaVersion": N, "payload": }@. Events written before the +-- envelope existed lack the key and are read as @schemaVersion = 1@; existing +-- rows are never rewritten. +-- +-- == Representation scope +-- +-- The core is parametric in @d@ so the machinery is stable across serializations, +-- but only JSON is shipped: every persistent store serializes to JSON +-- (@eventium-postgresql@ / @eventium-sqlite@ store @JSONString@); the in-memory +-- store keeps native values and never serializes, so schema evolution does not +-- apply there. Upcast-on-read is only meaningful against a __self-describing__ +-- representation (you must rewrite fields of old data whose Haskell type may be +-- gone). A future self-describing format (e.g. CBOR @Term@) instantiates @d@ with +-- its own envelope + combinators, core untouched. Protobuf is deliberately out of +-- this path: non-self-describing wire + native field evolution (no proto3 +-- required fields), so proto handles add\/remove itself and would use the +-- registry only for the /semantic/ hops it can't express. module Eventium.SchemaEvolution - ( -- * Versions and upcasters - EventTypeName, - SchemaVersion, - Upcaster, - - -- * Registry - SchemaRegistry, - emptyRegistry, - registerUpcasters, - currentVersion, - - -- * Upcaster combinators - atKey, - addFieldIfAbsent, - renameField, - removeField, - - -- * Envelope - wrapEnvelope, - unwrapEnvelope, - - -- * Codec - upcastingValueCodec, + ( module Eventium.SchemaEvolution.Types, + module Eventium.SchemaEvolution.Json, ) where -import Data.Aeson - ( FromJSON, - Result (..), - ToJSON, - Value (..), - fromJSON, - object, - toJSON, - (.=), - ) -import Data.Aeson.Key (Key) -import qualified Data.Aeson.KeyMap as KeyMap -import Data.Map.Strict (Map) -import qualified Data.Map.Strict as Map -import Eventium.Codec (Codec (..)) -import Eventium.Store.Types (EventTypeName) - --- | The schema version of an event type. Version numbering starts at 1. -type SchemaVersion = Int - --- | A pure, single-hop transform from one schema version's JSON to the next. -type Upcaster = Value -> Value - --- ----------------------------------------------------------------------------- --- Upcaster combinators --- ----------------------------------------------------------------------------- - --- These build the common field-level transforms without hand-rolled 'KeyMap' --- manipulation. Each is layout-agnostic and a no-op on non-object values, so --- they compose freely (e.g. focus into a nested object with 'atKey', then edit --- a field there). - --- | Apply an upcaster to the value at @key@ within an object, leaving the rest --- untouched. A no-op if @key@ is absent, or if the value is not an object. --- Use this to focus a field-level transform into a nested object (e.g. an --- Aeson tagged constructor's @contents@). -atKey :: Key -> Upcaster -> Upcaster -atKey key f (Object o) = case KeyMap.lookup key o of - Just v -> Object (KeyMap.insert key (f v) o) - Nothing -> Object o -atKey _ _ v = v - --- | Insert @key = value@ only if @key@ is not already present. Idempotent and --- never clobbers an existing value — the safe default for "a new field was --- added with default @value@". -addFieldIfAbsent :: Key -> Value -> Upcaster -addFieldIfAbsent key value (Object o) = Object (KeyMap.insertWith (\_new old -> old) key value o) -addFieldIfAbsent _ _ v = v - --- | Move the value at @from@ to @to@ (overwriting @to@ if present), dropping --- @from@. A no-op if @from@ is absent. -renameField :: Key -> Key -> Upcaster -renameField from to (Object o) = case KeyMap.lookup from o of - Just v -> Object (KeyMap.insert to v (KeyMap.delete from o)) - Nothing -> Object o -renameField _ _ v = v - --- | Remove @key@ from an object. A no-op if @key@ is absent. -removeField :: Key -> Upcaster -removeField key (Object o) = Object (KeyMap.delete key o) -removeField _ v = v - --- | A registry of upcaster chains, keyed by event-type name. The list for each --- type is ordered @[v1->v2, v2->v3, ...]@. -newtype SchemaRegistry = SchemaRegistry (Map EventTypeName [Upcaster]) - --- | A registry with no upcasters: every event type is at version 1. -emptyRegistry :: SchemaRegistry -emptyRegistry = SchemaRegistry Map.empty - --- | Register the ordered upcaster chain for an event type, replacing any --- existing entry. The list must be ordered @[v1->v2, v2->v3, ...]@; its length --- determines the type's current version. -registerUpcasters :: EventTypeName -> [Upcaster] -> SchemaRegistry -> SchemaRegistry -registerUpcasters eventType hops (SchemaRegistry m) = - SchemaRegistry (Map.insert eventType hops m) - --- | The current schema version of an event type: @1 + number of hops@. An --- unregistered type is at version 1. -currentVersion :: SchemaRegistry -> EventTypeName -> SchemaVersion -currentVersion reg eventType = 1 + length (hopsOf reg eventType) - --- | All registered hops for an event type (@[]@ if unregistered). -hopsOf :: SchemaRegistry -> EventTypeName -> [Upcaster] -hopsOf (SchemaRegistry m) eventType = Map.findWithDefault [] eventType m - --- | The hops needed to bring an event stored at @version@ up to current: drop --- the @version - 1@ hops already baked into the stored shape. -hopsFrom :: SchemaRegistry -> EventTypeName -> SchemaVersion -> [Upcaster] -hopsFrom reg eventType version = drop (max 0 (version - 1)) (hopsOf reg eventType) - -envelopeVersionKey :: KeyMap.Key -envelopeVersionKey = "schemaVersion" - -envelopePayloadKey :: KeyMap.Key -envelopePayloadKey = "payload" - --- | Wrap a payload in a versioned envelope. -wrapEnvelope :: SchemaVersion -> Value -> Value -wrapEnvelope version payload = - object [envelopeVersionKey .= version, envelopePayloadKey .= payload] - --- | Peel an envelope into @(version, payload)@. A value that is not a --- well-formed envelope — anything without both a numeric top-level --- @schemaVersion@ and a @payload@ sibling — is legacy pre-envelope data and is --- read as @(1, wholeValue)@. -unwrapEnvelope :: Value -> (SchemaVersion, Value) -unwrapEnvelope (Object o) - | Just version <- KeyMap.lookup envelopeVersionKey o >>= valueToInt, - Just payload <- KeyMap.lookup envelopePayloadKey o = - (version, payload) -unwrapEnvelope v = (1, v) - -valueToInt :: Value -> Maybe SchemaVersion -valueToInt v = case fromJSON v of - Success n -> Just n - Error _ -> Nothing - --- | A drop-in 'Codec' between a domain event type and its stored 'Value', --- applying schema evolution transparently. --- --- On 'encode', the current-version envelope is written. On 'decode', the --- envelope is peeled (or defaulted to version 1 for legacy data), the event --- type is resolved via @eventTypeOf@, the remaining upcaster hops are run, and --- the result is decoded into the current type. Decoding yields 'Nothing' if the --- upcasted value still does not match the current type. -upcastingValueCodec :: - (ToJSON a, FromJSON a) => - -- | Read the event-type name from a payload (the app's tagging convention). - (Value -> Maybe EventTypeName) -> - SchemaRegistry -> - Codec a Value -upcastingValueCodec eventTypeOf reg = - Codec - { encode = \a -> - let payload = toJSON a - version = maybe 1 (currentVersion reg) (eventTypeOf payload) - in wrapEnvelope version payload, - decode = \stored -> - let (version, payload) = unwrapEnvelope stored - upcasted = case eventTypeOf payload of - Just eventType -> foldl (\acc hop -> hop acc) payload (hopsFrom reg eventType version) - Nothing -> payload - in resultToMaybe (fromJSON upcasted) - } - where - resultToMaybe (Success a) = Just a - resultToMaybe (Error _) = Nothing +import Eventium.SchemaEvolution.Json +import Eventium.SchemaEvolution.Types diff --git a/src/Eventium/SchemaEvolution/Json.hs b/src/Eventium/SchemaEvolution/Json.hs new file mode 100644 --- /dev/null +++ b/src/Eventium/SchemaEvolution/Json.hs @@ -0,0 +1,173 @@ +{-# LANGUAGE OverloadedStrings #-} + +-- | The JSON instance of event schema evolution (see "Eventium.SchemaEvolution" +-- for the representation-agnostic core): the versioned envelope, field-level +-- upcaster combinators, and the upcasting 'Codec' — all over Aeson 'Value'. +-- +-- == Envelope +-- +-- Serialized payloads are wrapped in a versioned envelope: +-- +-- > { "schemaVersion": N, "payload": } +-- +-- Events written before this envelope existed lack the top-level +-- @schemaVersion@ key and are defined to be @schemaVersion = 1@ by convention; +-- their whole stored value is the payload. Existing rows are never rewritten. +-- +-- == Codec +-- +-- 'upcastingValueCodec' is a drop-in 'Codec' between a domain event type and its +-- stored 'Value'. It is parameterized by an @eventTypeOf@ function that reads the +-- type name from a payload (the caller's tagging convention), which keeps it +-- agnostic to how any particular app tags its events. Because it is a plain +-- 'Codec', it serves both synchronous (in-transaction) and asynchronous +-- (polling) consumers, and every event type and backend, with no reader-level +-- plumbing. +module Eventium.SchemaEvolution.Json + ( -- * JSON upcasters + JsonUpcaster, + + -- * Field combinators + atKey, + addFieldIfAbsent, + renameField, + removeField, + + -- * Envelope + wrapEnvelope, + unwrapEnvelope, + + -- * Codec + upcastingValueCodec, + ) +where + +import Data.Aeson + ( FromJSON, + Result (..), + ToJSON, + Value (..), + fromJSON, + object, + toJSON, + (.=), + ) +import Data.Aeson.Key (Key) +import qualified Data.Aeson.KeyMap as KeyMap +import Eventium.Codec (Codec (..)) +import Eventium.SchemaEvolution.Types + ( EventTypeName, + SchemaRegistry, + SchemaVersion, + Upcaster, + currentVersion, + upcast, + ) + +-- | An 'Upcaster' over the JSON document model (Aeson 'Value') — the one +-- representation eventium ships. +type JsonUpcaster = Upcaster Value + +-- ----------------------------------------------------------------------------- +-- Field combinators +-- ----------------------------------------------------------------------------- + +-- These build the common field-level transforms without hand-rolled 'KeyMap' +-- manipulation. Each is a no-op on non-object values, so they compose freely +-- (e.g. focus into a nested object with 'atKey', then edit a field there). + +-- | Apply an upcaster to the value at @key@ within an object, leaving the rest +-- untouched. A no-op if @key@ is absent, or if the value is not an object. +-- Use this to focus a field-level transform into a nested object (e.g. an +-- Aeson tagged constructor's @contents@). +atKey :: Key -> JsonUpcaster -> JsonUpcaster +atKey key f (Object o) = case KeyMap.lookup key o of + Just v -> Object (KeyMap.insert key (f v) o) + Nothing -> Object o +atKey _ _ v = v + +-- | Insert @key = value@ only if @key@ is not already present. Idempotent and +-- never clobbers an existing value — the safe default for "a new field was +-- added with default @value@". +addFieldIfAbsent :: Key -> Value -> JsonUpcaster +addFieldIfAbsent key value (Object o) = Object (KeyMap.insertWith (\_new old -> old) key value o) +addFieldIfAbsent _ _ v = v + +-- | Move the value at @from@ to @to@ (overwriting @to@ if present), dropping +-- @from@. A no-op if @from@ is absent. +renameField :: Key -> Key -> JsonUpcaster +renameField from to (Object o) = case KeyMap.lookup from o of + Just v -> Object (KeyMap.insert to v (KeyMap.delete from o)) + Nothing -> Object o +renameField _ _ v = v + +-- | Remove @key@ from an object. A no-op if @key@ is absent. +removeField :: Key -> JsonUpcaster +removeField key (Object o) = Object (KeyMap.delete key o) +removeField _ v = v + +-- ----------------------------------------------------------------------------- +-- Envelope +-- ----------------------------------------------------------------------------- + +envelopeVersionKey :: Key +envelopeVersionKey = "schemaVersion" + +envelopePayloadKey :: Key +envelopePayloadKey = "payload" + +-- | Wrap a payload in a versioned envelope. +wrapEnvelope :: SchemaVersion -> Value -> Value +wrapEnvelope version payload = + object [envelopeVersionKey .= version, envelopePayloadKey .= payload] + +-- | Peel an envelope into @(version, payload)@. A value that is not a +-- well-formed envelope — anything without both a numeric top-level +-- @schemaVersion@ and a @payload@ sibling — is legacy pre-envelope data and is +-- read as @(1, wholeValue)@. +unwrapEnvelope :: Value -> (SchemaVersion, Value) +unwrapEnvelope (Object o) + | Just version <- KeyMap.lookup envelopeVersionKey o >>= valueToInt, + Just payload <- KeyMap.lookup envelopePayloadKey o = + (version, payload) +unwrapEnvelope v = (1, v) + +valueToInt :: Value -> Maybe SchemaVersion +valueToInt v = case fromJSON v of + Success n -> Just n + Error _ -> Nothing + +-- ----------------------------------------------------------------------------- +-- Codec +-- ----------------------------------------------------------------------------- + +-- | A drop-in 'Codec' between a domain event type and its stored 'Value', +-- applying schema evolution transparently. +-- +-- On 'encode', the current-version envelope is written. On 'decode', the +-- envelope is peeled (or defaulted to version 1 for legacy data), the event +-- type is resolved via @eventTypeOf@, the remaining upcaster hops are run via +-- 'upcast', and the result is decoded into the current type. Decoding yields +-- 'Nothing' if the upcasted value still does not match the current type. +upcastingValueCodec :: + (ToJSON a, FromJSON a) => + -- | Read the event-type name from a payload (the app's tagging convention). + (Value -> Maybe EventTypeName) -> + SchemaRegistry Value -> + Codec a Value +upcastingValueCodec eventTypeOf reg = + Codec + { encode = \a -> + let payload = toJSON a + version = maybe 1 (currentVersion reg) (eventTypeOf payload) + in wrapEnvelope version payload, + decode = \stored -> + let (version, payload) = unwrapEnvelope stored + upcasted = case eventTypeOf payload of + Just eventType -> upcast reg eventType version payload + Nothing -> payload + in resultToMaybe (fromJSON upcasted) + } + where + resultToMaybe (Success a) = Just a + resultToMaybe (Error _) = Nothing diff --git a/src/Eventium/SchemaEvolution/Types.hs b/src/Eventium/SchemaEvolution/Types.hs new file mode 100644 --- /dev/null +++ b/src/Eventium/SchemaEvolution/Types.hs @@ -0,0 +1,76 @@ +-- | Representation-agnostic core of event schema evolution (see +-- "Eventium.SchemaEvolution" for the overview and the JSON instance). +-- +-- 'SchemaRegistry', 'registerUpcasters', 'currentVersion', and 'upcast' are +-- parametric in a document representation @d@ ('Upcaster' @d = d -> d@) and never +-- inspect it. The chaining, versioning, and version-skipping logic all live here +-- and are shared by every representation; only the envelope and field +-- combinators are representation-specific (e.g. "Eventium.SchemaEvolution.Json"). +module Eventium.SchemaEvolution.Types + ( -- * Versions and upcasters + EventTypeName, + SchemaVersion, + Upcaster, + + -- * Registry + SchemaRegistry, + emptyRegistry, + registerUpcasters, + currentVersion, + + -- * Applying the chain + upcast, + ) +where + +import Data.Map.Strict (Map) +import qualified Data.Map.Strict as Map +import Eventium.Store.Types (EventTypeName) + +-- | The schema version of an event type. Version numbering starts at 1. +type SchemaVersion = Int + +-- | A pure, single-hop transform from one schema version to the next, over a +-- serialization's document representation @d@. The registry and chaining are +-- parametric in @d@ and never inspect it; only the envelope and field +-- combinators (per representation, e.g. "Eventium.SchemaEvolution.Json") are +-- representation-specific. +type Upcaster d = d -> d + +-- | A registry of upcaster chains, keyed by event-type name, over a document +-- representation @d@. The list for each type is ordered @[v1->v2, v2->v3, ...]@. +-- The registry is parametric in @d@ and never inspects it. +newtype SchemaRegistry d = SchemaRegistry (Map EventTypeName [Upcaster d]) + +-- | A registry with no upcasters: every event type is at version 1. +emptyRegistry :: SchemaRegistry d +emptyRegistry = SchemaRegistry Map.empty + +-- | Register the ordered upcaster chain for an event type, replacing any +-- existing entry. The list must be ordered @[v1->v2, v2->v3, ...]@; its length +-- determines the type's current version. +registerUpcasters :: EventTypeName -> [Upcaster d] -> SchemaRegistry d -> SchemaRegistry d +registerUpcasters eventType hops (SchemaRegistry m) = + SchemaRegistry (Map.insert eventType hops m) + +-- | The current schema version of an event type: @1 + number of hops@. An +-- unregistered type is at version 1. +currentVersion :: SchemaRegistry d -> EventTypeName -> SchemaVersion +currentVersion reg eventType = 1 + length (hopsOf reg eventType) + +-- | Apply the upcaster chain that brings an event of @eventType@ stored at +-- @version@ up to the current shape: run the hops not yet baked into the stored +-- version, in order. Representation-agnostic — it only composes the registered +-- @d -> d@ hops. +upcast :: SchemaRegistry d -> EventTypeName -> SchemaVersion -> d -> d +upcast reg eventType version x = + foldl (\acc hop -> hop acc) x (hopsFrom reg eventType version) + +-- | All registered hops for an event type (@[]@ if unregistered). +hopsOf :: SchemaRegistry d -> EventTypeName -> [Upcaster d] +hopsOf (SchemaRegistry m) eventType = Map.findWithDefault [] eventType m + +-- | The hops needed to bring an event stored at @version@ up to current: drop +-- the @version - 1@ hops already baked into the stored shape. +hopsFrom :: SchemaRegistry d -> EventTypeName -> SchemaVersion -> [Upcaster d] +hopsFrom reg eventType version = drop (max 0 (version - 1)) (hopsOf reg eventType) diff --git a/src/Eventium/Store/Class.hs b/src/Eventium/Store/Class.hs --- a/src/Eventium/Store/Class.hs +++ b/src/Eventium/Store/Class.hs @@ -35,9 +35,8 @@ import Data.Functor ((<&>)) import Data.Functor.Contravariant import Data.Maybe (mapMaybe) -import qualified Data.Text as T import Data.Time (UTCTime, getCurrentTime) -import Data.Typeable (Typeable, typeOf) +import Data.Typeable (Typeable) import Eventium.Codec import Eventium.Store.Queries import Eventium.Store.Types @@ -200,7 +199,7 @@ map ( \e -> TaggedEvent - (enricher (EventMetadata (T.pack . show $ typeOf e) Nothing Nothing (Just now))) + (enricher (EventMetadata (eventTypeNameOf e) Nothing Nothing (Just now))) (codec.encode e) ) events @@ -217,7 +216,7 @@ tagEvents codec now = map $ \e -> TaggedEvent - (EventMetadata (T.pack . show $ typeOf e) Nothing Nothing (Just now)) + (EventMetadata (eventTypeNameOf e) Nothing Nothing (Just now)) (codec.encode e) -- | Like 'codecEventStoreWriter' but uses a 'TypeEmbedding' instead of diff --git a/src/Eventium/Store/Types.hs b/src/Eventium/Store/Types.hs --- a/src/Eventium/Store/Types.hs +++ b/src/Eventium/Store/Types.hs @@ -1,6 +1,9 @@ +{-# LANGUAGE AllowAmbiguousTypes #-} {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE DeriveTraversable #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TypeApplications #-} -- | Pure data types for the event store. These types have no dependency on -- any monad or effect system. They are extracted from "Eventium.Store.Class" @@ -14,6 +17,8 @@ -- * Event metadata EventTypeName, + eventTypeName, + eventTypeNameOf, EventMetadata (..), emptyMetadata, MetadataEnricher, @@ -39,10 +44,11 @@ import Data.Aeson import qualified Data.List.NonEmpty as NE -import Data.Text (Text) +import Data.Text (Text, pack) import Data.Time (UTCTime) import Eventium.UUID import GHC.Generics (Generic) +import Type.Reflection (Typeable, typeRep) import Web.HttpApiData import Web.PathPieces @@ -50,6 +56,18 @@ -- 'EventMetadata', or the discriminator tag an app uses to key its schema -- evolution registry (see "Eventium.SchemaEvolution"). type EventTypeName = Text + +-- | The 'EventTypeName' of an event type: its unqualified type name, derived +-- from 'Typeable'. Use when you have the type but no value — e.g. keying a +-- schema-evolution registry: @eventTypeName \@MyEvent@. +eventTypeName :: forall a. (Typeable a) => EventTypeName +eventTypeName = pack (show (typeRep @a)) + +-- | 'eventTypeName' for the type of a value. Handy at write time, where an +-- event value is in hand (e.g. deriving 'EventMetadata.eventType'). The value +-- is inspected only for its type. +eventTypeNameOf :: forall a. (Typeable a) => a -> EventTypeName +eventTypeNameOf _ = eventTypeName @a -- | Metadata carried alongside every stored event. data EventMetadata = EventMetadata diff --git a/tests/Eventium/SchemaEvolutionSpec.hs b/tests/Eventium/SchemaEvolutionSpec.hs --- a/tests/Eventium/SchemaEvolutionSpec.hs +++ b/tests/Eventium/SchemaEvolutionSpec.hs @@ -70,7 +70,7 @@ setStep n (Object o) = Object (KeyMap.insert "step" (toJSON n) o) setStep _ v = v -registry :: SchemaRegistry +registry :: SchemaRegistry Value registry = registerUpcasters "Gizmo" [injectEnabled] $ registerUpcasters "Chain" [setStep 2, setStep 3] emptyRegistry