packages feed

eventium-sql-common (empty) → 0.1.0

raw patch · 7 files changed

+409/−0 lines, 7 filesdep +aesondep +basedep +bytestring

Dependencies added: aeson, base, bytestring, eventium-core, mtl, persistent, persistent-template, text, uuid

Files

+ LICENSE.md view
@@ -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.
+ eventium-sql-common.cabal view
@@ -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
+ src/Eventium/Store/Sql.hs view
@@ -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 ()
+ src/Eventium/Store/Sql/DefaultEntity.hs view
@@ -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
+ src/Eventium/Store/Sql/JSONString.hs view
@@ -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
+ src/Eventium/Store/Sql/Operations.hs view
@@ -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)
+ src/Eventium/Store/Sql/Orphans.hs view
@@ -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)