diff --git a/LICENSE.md b/LICENSE.md new file mode 100644 --- /dev/null +++ b/LICENSE.md @@ -0,0 +1,20 @@ +Copyright (c) 2025 Alexander Sidorenko +Copyright (c) 2016-2017 David Reaver + +Permission is hereby granted, free of charge, to any person obtaining a copy of +this software and associated documentation files (the "Software"), to deal in +the Software without restriction, including without limitation the rights to +use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies +of the Software, and to permit persons to whom the Software is furnished to do +so, subject to the following conditions: + +The above copyright notice and this permission notice shall be included in all +copies or substantial portions of the Software. + +THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR +IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, +FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE +AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER +LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, +OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE +SOFTWARE. diff --git a/eventium-sql-common.cabal b/eventium-sql-common.cabal new file mode 100644 --- /dev/null +++ b/eventium-sql-common.cabal @@ -0,0 +1,50 @@ +cabal-version: 1.12 + +-- This file has been generated from package.yaml by hpack version 0.37.0. +-- +-- see: https://github.com/sol/hpack + +name: eventium-sql-common +version: 0.1.0 +synopsis: Common library for SQL event stores +description: Eventium-sql-common provides shared utilities and abstractions for SQL-based event stores. + It includes Persistent entity definitions, JSON serialization helpers, and common database + operations used by eventium-postgresql and eventium-sqlite. This package eliminates code + duplication between different SQL backend implementations and provides a consistent interface + for SQL-based event sourcing. +category: Database,Eventsourcing +stability: experimental +homepage: https://github.com/aleks-sidorenko/eventium#readme +bug-reports: https://github.com/aleks-sidorenko/eventium/issues +maintainer: Alexander Sidorenko +license: MIT +license-file: LICENSE.md +build-type: Simple + +source-repository head + type: git + location: https://github.com/aleks-sidorenko/eventium + +library + exposed-modules: + Eventium.Store.Sql + Eventium.Store.Sql.DefaultEntity + Eventium.Store.Sql.JSONString + Eventium.Store.Sql.Operations + Eventium.Store.Sql.Orphans + other-modules: + Paths_eventium_sql_common + hs-source-dirs: + src + ghc-options: -Wall + build-depends: + aeson >=1.5 && <2.3 + , base >=4.9 && <5 + , bytestring >=0.10 && <0.13 + , eventium-core + , mtl >=2.2 && <2.4 + , persistent >=2.13 && <2.15 + , persistent-template >=2.12 && <2.13 + , text >=1.2 && <2.2 + , uuid >=1.3 && <1.4 + default-language: Haskell2010 diff --git a/src/Eventium/Store/Sql.hs b/src/Eventium/Store/Sql.hs new file mode 100644 --- /dev/null +++ b/src/Eventium/Store/Sql.hs @@ -0,0 +1,9 @@ +module Eventium.Store.Sql + ( module X, + ) +where + +import Eventium.Store.Sql.DefaultEntity as X +import Eventium.Store.Sql.JSONString as X +import Eventium.Store.Sql.Operations as X +import Eventium.Store.Sql.Orphans as X () diff --git a/src/Eventium/Store/Sql/DefaultEntity.hs b/src/Eventium/Store/Sql/DefaultEntity.hs new file mode 100644 --- /dev/null +++ b/src/Eventium/Store/Sql/DefaultEntity.hs @@ -0,0 +1,64 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE DerivingStrategies #-} +{-# LANGUAGE ExistentialQuantification #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE GeneralizedNewtypeDeriving #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE QuasiQuotes #-} +{-# LANGUAGE StandaloneDeriving #-} +{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE TypeOperators #-} +{-# LANGUAGE UndecidableInstances #-} + +-- | Definition for a default Entity to use with a SQL event store. +module Eventium.Store.Sql.DefaultEntity + ( SqlEvent (..), + SqlEventId, + migrateSqlEvent, + defaultSqlEventStoreConfig, + ) +where + +import Database.Persist (Key) +import Database.Persist.Sql (fromSqlKey, toSqlKey) +import Database.Persist.TH +import Eventium.Store.Class +import Eventium.Store.Sql.JSONString +import Eventium.Store.Sql.Operations +import Eventium.Store.Sql.Orphans () +import Eventium.UUID + +share + [mkPersist sqlSettings, mkMigrate "migrateSqlEvent"] + [persistLowerCase| +SqlEvent sql=events + uuid UUID + version EventVersion + event JSONString + UniqueUuidVersion uuid version + deriving Show +|] + +sqlEventMakeKey :: SequenceNumber -> Key SqlEvent +sqlEventMakeKey sequenceNumber = + toSqlKey (fromIntegral (unSequenceNumber sequenceNumber)) + +sqlEventUnKey :: Key SqlEvent -> SequenceNumber +sqlEventUnKey key = + SequenceNumber (fromIntegral (fromSqlKey key)) + +defaultSqlEventStoreConfig :: SqlEventStoreConfig SqlEvent JSONString +defaultSqlEventStoreConfig = + SqlEventStoreConfig + SqlEvent + sqlEventMakeKey + sqlEventUnKey + sqlEventUuid + sqlEventVersion + sqlEventEvent + SqlEventId + SqlEventUuid + SqlEventVersion + SqlEventEvent diff --git a/src/Eventium/Store/Sql/JSONString.hs b/src/Eventium/Store/Sql/JSONString.hs new file mode 100644 --- /dev/null +++ b/src/Eventium/Store/Sql/JSONString.hs @@ -0,0 +1,41 @@ +{-# LANGUAGE GeneralizedNewtypeDeriving #-} +{-# LANGUAGE OverloadedStrings #-} + +module Eventium.Store.Sql.JSONString + ( JSONString, + jsonStringSerializer, + ) +where + +import Data.Aeson +import Data.Text.Lazy (Text) +import qualified Data.Text.Lazy.Encoding as TLE +import Database.Persist +import Database.Persist.Sql +import Eventium.Serializer + +-- | A more specific type than just ByteString for JSON data. +newtype JSONString = JSONString {unJSONString :: Text} + deriving (Eq, PersistField) + +instance PersistFieldSql JSONString where + sqlType _ = SqlOther "jsonb" + +instance Show JSONString where + show = show . unJSONString + +jsonStringSerializer :: (ToJSON a, FromJSON a) => Serializer a JSONString +jsonStringSerializer = + Serializer + encodeJSON + decodeJSON + decodeJSONEither + +encodeJSON :: (ToJSON a) => a -> JSONString +encodeJSON = JSONString . TLE.decodeUtf8 . encode + +decodeJSON :: (FromJSON a) => JSONString -> Maybe a +decodeJSON = decode . TLE.encodeUtf8 . unJSONString + +decodeJSONEither :: (FromJSON a) => JSONString -> Either String a +decodeJSONEither = eitherDecode . TLE.encodeUtf8 . unJSONString diff --git a/src/Eventium/Store/Sql/Operations.hs b/src/Eventium/Store/Sql/Operations.hs new file mode 100644 --- /dev/null +++ b/src/Eventium/Store/Sql/Operations.hs @@ -0,0 +1,177 @@ +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE TypeOperators #-} + +module Eventium.Store.Sql.Operations + ( SqlEventStoreConfig (..), + sqlEventStoreReader, + sqlGlobalEventStoreReader, + sqlGetProjectionIds, + sqlGetStreamEvents, + sqlMaxEventVersion, + sqlStoreEvents, + unsafeSqlStoreGlobalStreamEvents, + ) +where + +import Control.Monad.IO.Class +import Data.Foldable (for_) +import Data.Maybe (listToMaybe) +import Data.Text (Text) +import Database.Persist +import Database.Persist.Class (SafeToInsert) +import Database.Persist.Names (EntityNameDB (..), FieldNameDB (..)) +import Database.Persist.Sql +import Eventium.Store.Class +import Eventium.Store.Sql.Orphans as X () +import Eventium.UUID + +data SqlEventStoreConfig entity serialized + = SqlEventStoreConfig + { sqlEventStoreConfigSequenceMakeEntity :: UUID -> EventVersion -> serialized -> entity, + -- Key manipulation + sqlEventStoreConfigMakeKey :: SequenceNumber -> Key entity, + sqlEventStoreConfigUnKey :: Key entity -> SequenceNumber, + -- Record functions + sqlEventStoreConfigUUID :: entity -> UUID, + sqlEventStoreConfigVersion :: entity -> EventVersion, + sqlEventStoreConfigData :: entity -> serialized, + -- EntityFields + sqlEventStoreConfigSequenceNumberField :: EntityField entity (Key entity), + sqlEventStoreConfigUUIDField :: EntityField entity UUID, + sqlEventStoreConfigVersionField :: EntityField entity EventVersion, + sqlEventStoreConfigDataField :: EntityField entity serialized + } + +sqlEventStoreReader :: + (MonadIO m, PersistEntity entity, PersistEntityBackend entity ~ SqlBackend) => + SqlEventStoreConfig entity serialized -> + VersionedEventStoreReader (SqlPersistT m) serialized +sqlEventStoreReader config = EventStoreReader $ sqlGetStreamEvents config + +sqlGlobalEventStoreReader :: + (MonadIO m, PersistEntity entity, PersistEntityBackend entity ~ SqlBackend) => + SqlEventStoreConfig entity serialized -> + GlobalEventStoreReader (SqlPersistT m) serialized +sqlGlobalEventStoreReader config = + EventStoreReader $ sqlGetAllEventsInRange config + +sqlEventToGlobalStream :: + SqlEventStoreConfig entity serialized -> + Entity entity -> + GlobalStreamEvent serialized +sqlEventToGlobalStream config@SqlEventStoreConfig {..} (Entity key event) = + StreamEvent () (sqlEventStoreConfigUnKey key) (sqlEventToVersioned config event) + +sqlEventToVersioned :: + SqlEventStoreConfig entity serialized -> + entity -> + VersionedStreamEvent serialized +sqlEventToVersioned SqlEventStoreConfig {..} entity = + StreamEvent + (sqlEventStoreConfigUUID entity) + (sqlEventStoreConfigVersion entity) + (sqlEventStoreConfigData entity) + +sqlGetProjectionIds :: + (MonadIO m, PersistEntity entity, PersistEntityBackend entity ~ SqlBackend) => + SqlEventStoreConfig entity serialized -> + SqlPersistT m [UUID] +sqlGetProjectionIds SqlEventStoreConfig {..} = + fmap unSingle <$> rawSql ("SELECT DISTINCT " <> uuidFieldName <> " FROM " <> tableName) [] + where + tableName = unEntityNameDB $ tableDBName (sqlEventStoreConfigSequenceMakeEntity nil 0 undefined) + uuidFieldName = unFieldNameDB $ fieldDBName sqlEventStoreConfigSequenceNumberField + +sqlGetStreamEvents :: + (MonadIO m, PersistEntity entity, PersistEntityBackend entity ~ SqlBackend) => + SqlEventStoreConfig entity serialized -> + QueryRange UUID EventVersion -> + SqlPersistT m [VersionedStreamEvent serialized] +sqlGetStreamEvents config@SqlEventStoreConfig {..} QueryRange {..} = do + entities <- selectList filters selectOpts + return $ sqlEventToVersioned config . entityVal <$> entities + where + startFilter = + case queryRangeStart of + StartFromBeginning -> [] + StartQueryAt start -> [sqlEventStoreConfigVersionField >=. start] + (endFilter, endSelectOpt) = + case queryRangeLimit of + NoQueryLimit -> ([], []) + MaxNumberOfEvents maxNum -> ([], [LimitTo maxNum]) + StopQueryAt stop -> ([sqlEventStoreConfigVersionField <=. stop], []) + filters = (sqlEventStoreConfigUUIDField ==. queryRangeKey) : startFilter ++ endFilter + selectOpts = Asc sqlEventStoreConfigSequenceNumberField : endSelectOpt + +sqlGetAllEventsInRange :: + (MonadIO m, PersistEntity entity, PersistEntityBackend entity ~ SqlBackend) => + SqlEventStoreConfig entity serialized -> + QueryRange () SequenceNumber -> + SqlPersistT m [GlobalStreamEvent serialized] +sqlGetAllEventsInRange config@SqlEventStoreConfig {..} QueryRange {..} = do + entities <- selectList filters selectOpts + return $ sqlEventToGlobalStream config <$> entities + where + startFilter = + case queryRangeStart of + StartFromBeginning -> [] + StartQueryAt start -> [sqlEventStoreConfigSequenceNumberField >=. sqlEventStoreConfigMakeKey start] + (endFilter, endSelectOpt) = + case queryRangeLimit of + NoQueryLimit -> ([], []) + MaxNumberOfEvents maxNum -> ([], [LimitTo maxNum]) + StopQueryAt stop -> ([sqlEventStoreConfigSequenceNumberField <=. sqlEventStoreConfigMakeKey stop], []) + filters = startFilter ++ endFilter + selectOpts = Asc sqlEventStoreConfigSequenceNumberField : endSelectOpt + +sqlMaxEventVersion :: + (MonadIO m, PersistEntity entity, PersistEntityBackend entity ~ SqlBackend) => + SqlEventStoreConfig entity serialized -> + (FieldNameDB -> FieldNameDB -> FieldNameDB -> Text) -> + UUID -> + SqlPersistT m EventVersion +sqlMaxEventVersion SqlEventStoreConfig {..} maxVersionSql uuid = + let tableName = FieldNameDB $ unEntityNameDB $ tableDBName (sqlEventStoreConfigSequenceMakeEntity nil 0 undefined) + uuidFieldName = fieldDBName sqlEventStoreConfigUUIDField + versionFieldName = fieldDBName sqlEventStoreConfigVersionField + rawVals = rawSql (maxVersionSql tableName uuidFieldName versionFieldName) [toPersistValue uuid] + in maybe 0 unSingle . listToMaybe <$> rawVals + +sqlStoreEvents :: + (MonadIO m, PersistEntity entity, PersistEntityBackend entity ~ SqlBackend, SafeToInsert entity) => + SqlEventStoreConfig entity serialized -> + Maybe (Text -> Text) -> + (FieldNameDB -> FieldNameDB -> FieldNameDB -> Text) -> + UUID -> + [serialized] -> + SqlPersistT m EventVersion +sqlStoreEvents config@SqlEventStoreConfig {..} mLockCommand maxVersionSql uuid events = do + versionNum <- sqlMaxEventVersion config maxVersionSql uuid + let entities = zipWith (sqlEventStoreConfigSequenceMakeEntity uuid) [versionNum + 1 ..] events + -- NB: We need to take a lock on the events table or else the global sequence + -- numbers may not increase monotonically over time. + for_ mLockCommand $ \lockCommand -> rawExecute (lockCommand tableName) [] + _ <- insertMany entities + return $ versionNum + EventVersion (length events) + where + tableName = unEntityNameDB $ tableDBName (sqlEventStoreConfigSequenceMakeEntity nil 0 undefined) + +-- | Useful if you have some 'GlobalStreamEvent's and you want to shove them in +-- a SQL event store. This can happen when you are moving events between event +-- stores, or you somehow generate the events outside of the current SQL event +-- store. +unsafeSqlStoreGlobalStreamEvents :: + (MonadIO m, PersistEntity entity, PersistEntityBackend entity ~ SqlBackend) => + SqlEventStoreConfig entity serialized -> + [GlobalStreamEvent serialized] -> + SqlPersistT m () +unsafeSqlStoreGlobalStreamEvents SqlEventStoreConfig {..} events = + insertEntityMany $ fmap mkEventEntity events + where + mkEventEntity (StreamEvent () seqNum (StreamEvent uuid vers event)) = + Entity + (sqlEventStoreConfigMakeKey seqNum) + (sqlEventStoreConfigSequenceMakeEntity uuid vers event) diff --git a/src/Eventium/Store/Sql/Orphans.hs b/src/Eventium/Store/Sql/Orphans.hs new file mode 100644 --- /dev/null +++ b/src/Eventium/Store/Sql/Orphans.hs @@ -0,0 +1,48 @@ +{-# LANGUAGE OverloadedStrings #-} +{-# OPTIONS_GHC -fno-warn-orphans #-} + +module Eventium.Store.Sql.Orphans + ( + ) +where + +import qualified Data.ByteString as BS +import Data.Proxy +import qualified Data.Text as T +import qualified Data.Text.Encoding as TE +import Data.UUID +import Database.Persist +import Database.Persist.Sql +import Eventium.Store.Class +import Eventium.UUID + +instance PersistField UUID where + toPersistValue = PersistText . uuidToText + fromPersistValue (PersistText t) = + case uuidFromText t of + Just x -> Right x + Nothing -> Left "Invalid UUID" + fromPersistValue (PersistByteString bs) = + maybe (Left "Invalid UUID") Right (uuidFromText (TE.decodeUtf8 bs)) + fromPersistValue (PersistDbSpecific bs) = + maybe (Left "Invalid UUID") Right (uuidFromText (TE.decodeUtf8 bs)) + fromPersistValue (PersistLiteral_ _ bs) = + maybe (Left "Invalid UUID") Right (uuidFromText (TE.decodeUtf8 bs)) + fromPersistValue v = Left $ "Expected UUID-compatible PersistValue, got: " <> T.pack (show v) + +instance PersistFieldSql UUID where + sqlType _ = SqlOther "uuid" + +instance PersistField EventVersion where + toPersistValue = toPersistValue . unEventVersion + fromPersistValue = fmap EventVersion . fromPersistValue + +instance PersistFieldSql EventVersion where + sqlType _ = sqlType (Proxy :: Proxy Int) + +instance PersistField SequenceNumber where + toPersistValue = toPersistValue . unSequenceNumber + fromPersistValue = fmap SequenceNumber . fromPersistValue + +instance PersistFieldSql SequenceNumber where + sqlType _ = sqlType (Proxy :: Proxy Int)