diff --git a/eventium-sql-common.cabal b/eventium-sql-common.cabal --- a/eventium-sql-common.cabal +++ b/eventium-sql-common.cabal @@ -1,11 +1,11 @@ cabal-version: 1.12 --- This file has been generated from package.yaml by hpack version 0.37.0. +-- This file has been generated from package.yaml by hpack version 0.38.3. -- -- see: https://github.com/sol/hpack name: eventium-sql-common -version: 0.1.0 +version: 0.2.1 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 @@ -25,8 +25,14 @@ type: git location: https://github.com/aleks-sidorenko/eventium +flag ci + description: Enable -Werror for CI builds + manual: True + default: False + library exposed-modules: + Eventium.ProjectionCache.Sql Eventium.Store.Sql Eventium.Store.Sql.DefaultEntity Eventium.Store.Sql.JSONString @@ -36,15 +42,21 @@ Paths_eventium_sql_common hs-source-dirs: src - ghc-options: -Wall + default-extensions: + NoFieldSelectors + DuplicateRecordFields + OverloadedRecordDot + ghc-options: -Wall -Wcompat -Widentities -Wincomplete-record-updates -Wredundant-constraints -Wno-type-defaults -Wno-incomplete-uni-patterns build-depends: aeson >=1.5 && <2.3 , base >=4.9 && <5 , bytestring >=0.10 && <0.13 - , eventium-core + , eventium-core >=0.2.0 && <0.3.0 , mtl >=2.2 && <2.4 - , persistent >=2.13 && <2.15 - , persistent-template >=2.12 && <2.13 + , persistent >=2.14 && <2.18 , text >=1.2 && <2.2 - , uuid >=1.3 && <1.4 + , time >=1.9 && <1.14 + , uuid ==1.3.* default-language: Haskell2010 + if flag(ci) + ghc-options: -Werror diff --git a/src/Eventium/ProjectionCache/Sql.hs b/src/Eventium/ProjectionCache/Sql.hs new file mode 100644 --- /dev/null +++ b/src/Eventium/ProjectionCache/Sql.hs @@ -0,0 +1,150 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE DerivingStrategies #-} +{-# LANGUAGE ExistentialQuantification #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE GeneralizedNewtypeDeriving #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE OverloadedRecordDot #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE QuasiQuotes #-} +{-# LANGUAGE StandaloneDeriving #-} +{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE TypeOperators #-} +{-# LANGUAGE UndecidableInstances #-} +{-# LANGUAGE NoFieldSelectors #-} + +module Eventium.ProjectionCache.Sql + ( ProjectionName (..), + CheckpointName (..), + ProjectionSnapshotEntity (..), + migrateProjectionSnapshot, + sqlVersionedProjectionCache, + sqlGlobalProjectionCache, + sqlCheckpointStore, + ) +where + +import Control.Monad.IO.Class (MonadIO, liftIO) +import Data.Aeson (FromJSON, ToJSON, Value (Object)) +import Data.Text (Text) +import Data.Time (UTCTime, getCurrentTime) +import Database.Persist +import Database.Persist.Sql +import Database.Persist.TH +import Eventium.EventSubscription (CheckpointStore (..)) +import Eventium.ProjectionCache.Types +import Eventium.Store.Class (EventVersion (..), SequenceNumber (..)) +import Eventium.Store.Sql.JSONString (JSONString, encodeJSON) +import Eventium.Store.Sql.Orphans () +import Eventium.UUID (UUID, nil) + +-- | A name identifying a projection in the projection cache. +-- Used as a discriminator so multiple projections can share one storage table. +newtype ProjectionName = ProjectionName Text + deriving (Show, Read, Eq, Ord, ToJSON, FromJSON, PersistField, PersistFieldSql) + +-- | A name identifying a checkpoint in the projection snapshots table. +-- Distinct from 'ProjectionName' to maintain semantic clarity — checkpoint +-- stores track subscription position, while projection caches store +-- aggregate snapshots. +newtype CheckpointName = CheckpointName Text + deriving (Show, Read, Eq, Ord, ToJSON, FromJSON, PersistField, PersistFieldSql) + +share + [mkPersist sqlSettings {mpsFieldLabelModifier = const id}, mkMigrate "migrateProjectionSnapshot"] + [persistLowerCase| +ProjectionSnapshotEntity sql=projection_snapshots + projectionName ProjectionName + entityId UUID sql=key + position Int + state JSONString + updatedAt UTCTime + Primary projectionName entityId + deriving Show +|] + +-- | A SQL-backed 'ProjectionCache' for per-entity snapshots. +-- +-- Stores one row per entity. The @key@ is a UUID (aggregate/entity ID) +-- and @position@ is an EventVersion. +-- +-- Composes with 'codecProjectionCache' for state encoding. +-- Works with both PostgreSQL and SQLite via Persistent. +sqlVersionedProjectionCache :: + (MonadIO m) => + ProjectionName -> + ProjectionCache UUID EventVersion JSONString (SqlPersistT m) +sqlVersionedProjectionCache name = + ProjectionCache + { storeSnapshot = \uuid (EventVersion ver) state -> do + now <- liftIO getCurrentTime + repsert (ProjectionSnapshotEntityKey name uuid) $ + ProjectionSnapshotEntity + { projectionName = name, + entityId = uuid, + position = ver, + state = state, + updatedAt = now + }, + loadSnapshot = \uuid -> do + mEntity <- get (ProjectionSnapshotEntityKey name uuid) + return $ fmap (\e -> (EventVersion e.position, e.state)) mEntity + } + +-- | A SQL-backed 'ProjectionCache' for global blob snapshots. +-- +-- Stores one row per read model using 'nil' UUID as the key. +-- The @position@ is a SequenceNumber. +-- +-- Composes with 'codecProjectionCache' for state encoding. +-- Works with both PostgreSQL and SQLite via Persistent. +sqlGlobalProjectionCache :: + (MonadIO m) => + ProjectionName -> + ProjectionCache () SequenceNumber JSONString (SqlPersistT m) +sqlGlobalProjectionCache name = + ProjectionCache + { storeSnapshot = \() (SequenceNumber sn) state -> do + now <- liftIO getCurrentTime + repsert (ProjectionSnapshotEntityKey name nil) $ + ProjectionSnapshotEntity + { projectionName = name, + entityId = nil, + position = sn, + state = state, + updatedAt = now + }, + loadSnapshot = \() -> do + mEntity <- get (ProjectionSnapshotEntityKey name nil) + return $ fmap (\e -> (SequenceNumber e.position, e.state)) mEntity + } + +-- | A SQL-backed 'CheckpointStore' for tracking 'SequenceNumber' position. +-- +-- Reuses the @projection_snapshots@ table. Stores one row with the +-- 'CheckpointName' as the projection name and 'nil' UUID as the entity key. +-- The @position@ column stores the sequence number; the @state@ column +-- stores an empty JSON string. +sqlCheckpointStore :: + (MonadIO m) => + CheckpointName -> + CheckpointStore (SqlPersistT m) SequenceNumber +sqlCheckpointStore (CheckpointName name) = + let projName = ProjectionName name + in CheckpointStore + { getCheckpoint = do + mEntity <- get (ProjectionSnapshotEntityKey projName nil) + return $ maybe 0 (SequenceNumber . (.position)) mEntity, + saveCheckpoint = \(SequenceNumber sn) -> do + now <- liftIO getCurrentTime + repsert (ProjectionSnapshotEntityKey projName nil) $ + ProjectionSnapshotEntity + { projectionName = projName, + entityId = nil, + position = sn, + state = encodeJSON (Object mempty), + updatedAt = now + } + } diff --git a/src/Eventium/Store/Sql.hs b/src/Eventium/Store/Sql.hs --- a/src/Eventium/Store/Sql.hs +++ b/src/Eventium/Store/Sql.hs @@ -3,6 +3,7 @@ ) where +import Eventium.ProjectionCache.Sql as X import Eventium.Store.Sql.DefaultEntity as X import Eventium.Store.Sql.JSONString as X import Eventium.Store.Sql.Operations as X diff --git a/src/Eventium/Store/Sql/DefaultEntity.hs b/src/Eventium/Store/Sql/DefaultEntity.hs --- a/src/Eventium/Store/Sql/DefaultEntity.hs +++ b/src/Eventium/Store/Sql/DefaultEntity.hs @@ -36,14 +36,15 @@ SqlEvent sql=events uuid UUID version EventVersion - event JSONString + payload JSONString + metadata JSONString Maybe UniqueUuidVersion uuid version deriving Show |] sqlEventMakeKey :: SequenceNumber -> Key SqlEvent -sqlEventMakeKey sequenceNumber = - toSqlKey (fromIntegral (unSequenceNumber sequenceNumber)) +sqlEventMakeKey (SequenceNumber n) = + toSqlKey (fromIntegral n) sqlEventUnKey :: Key SqlEvent -> SequenceNumber sqlEventUnKey key = @@ -52,13 +53,16 @@ defaultSqlEventStoreConfig :: SqlEventStoreConfig SqlEvent JSONString defaultSqlEventStoreConfig = SqlEventStoreConfig - SqlEvent - sqlEventMakeKey - sqlEventUnKey - sqlEventUuid - sqlEventVersion - sqlEventEvent - SqlEventId - SqlEventUuid - SqlEventVersion - SqlEventEvent + { sequenceMakeEntity = SqlEvent, + makeKey = sqlEventMakeKey, + unKey = sqlEventUnKey, + uuid = \(SqlEvent u _ _ _) -> u, + version = \(SqlEvent _ v _ _) -> v, + payload = \(SqlEvent _ _ p _) -> p, + metadata = \(SqlEvent _ _ _ m) -> m, + sequenceNumberField = SqlEventId, + uuidField = SqlEventUuid, + versionField = SqlEventVersion, + payloadField = SqlEventPayload, + metadataField = SqlEventMetadata + } diff --git a/src/Eventium/Store/Sql/JSONString.hs b/src/Eventium/Store/Sql/JSONString.hs --- a/src/Eventium/Store/Sql/JSONString.hs +++ b/src/Eventium/Store/Sql/JSONString.hs @@ -3,39 +3,37 @@ module Eventium.Store.Sql.JSONString ( JSONString, - jsonStringSerializer, + jsonStringCodec, + encodeJSON, + decodeJSON, ) where -import Data.Aeson +import qualified Data.Aeson as Aeson import Data.Text.Lazy (Text) import qualified Data.Text.Lazy.Encoding as TLE import Database.Persist import Database.Persist.Sql -import Eventium.Serializer +import Eventium.Codec (Codec (..)) -- | A more specific type than just ByteString for JSON data. -newtype JSONString = JSONString {unJSONString :: Text} +newtype JSONString = JSONString Text deriving (Eq, PersistField) instance PersistFieldSql JSONString where sqlType _ = SqlOther "jsonb" instance Show JSONString where - show = show . unJSONString + show (JSONString t) = show t -jsonStringSerializer :: (ToJSON a, FromJSON a) => Serializer a JSONString -jsonStringSerializer = - Serializer +jsonStringCodec :: (Aeson.ToJSON a, Aeson.FromJSON a) => Codec a JSONString +jsonStringCodec = + Codec encodeJSON decodeJSON - decodeJSONEither -encodeJSON :: (ToJSON a) => a -> JSONString -encodeJSON = JSONString . TLE.decodeUtf8 . encode - -decodeJSON :: (FromJSON a) => JSONString -> Maybe a -decodeJSON = decode . TLE.encodeUtf8 . unJSONString +encodeJSON :: (Aeson.ToJSON a) => a -> JSONString +encodeJSON = JSONString . TLE.decodeUtf8 . Aeson.encode -decodeJSONEither :: (FromJSON a) => JSONString -> Either String a -decodeJSONEither = eitherDecode . TLE.encodeUtf8 . unJSONString +decodeJSON :: (Aeson.FromJSON a) => JSONString -> Maybe a +decodeJSON (JSONString t) = Aeson.decode . TLE.encodeUtf8 $ t diff --git a/src/Eventium/Store/Sql/Operations.hs b/src/Eventium/Store/Sql/Operations.hs --- a/src/Eventium/Store/Sql/Operations.hs +++ b/src/Eventium/Store/Sql/Operations.hs @@ -1,5 +1,4 @@ {-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE RecordWildCards #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE TypeOperators #-} @@ -12,37 +11,39 @@ sqlGetStreamEvents, sqlMaxEventVersion, sqlStoreEvents, + sqlStoreEventsTagged, unsafeSqlStoreGlobalStreamEvents, ) where import Control.Monad.IO.Class import Data.Foldable (for_) -import Data.Maybe (listToMaybe) +import Data.Maybe (fromMaybe, 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.JSONString (JSONString, decodeJSON, encodeJSON) import Eventium.Store.Sql.Orphans as X () import Eventium.UUID data SqlEventStoreConfig entity serialized = SqlEventStoreConfig - { sqlEventStoreConfigSequenceMakeEntity :: UUID -> EventVersion -> serialized -> entity, + { sequenceMakeEntity :: UUID -> EventVersion -> serialized -> Maybe JSONString -> entity, -- Key manipulation - sqlEventStoreConfigMakeKey :: SequenceNumber -> Key entity, - sqlEventStoreConfigUnKey :: Key entity -> SequenceNumber, + makeKey :: SequenceNumber -> Key entity, + unKey :: Key entity -> SequenceNumber, -- Record functions - sqlEventStoreConfigUUID :: entity -> UUID, - sqlEventStoreConfigVersion :: entity -> EventVersion, - sqlEventStoreConfigData :: entity -> serialized, + uuid :: entity -> UUID, + version :: entity -> EventVersion, + payload :: entity -> serialized, + metadata :: entity -> Maybe JSONString, -- EntityFields - sqlEventStoreConfigSequenceNumberField :: EntityField entity (Key entity), - sqlEventStoreConfigUUIDField :: EntityField entity UUID, - sqlEventStoreConfigVersionField :: EntityField entity EventVersion, - sqlEventStoreConfigDataField :: EntityField entity serialized + sequenceNumberField :: EntityField entity (Key entity), + uuidField :: EntityField entity UUID, + versionField :: EntityField entity EventVersion, + payloadField :: EntityField entity serialized, + metadataField :: EntityField entity (Maybe JSONString) } sqlEventStoreReader :: @@ -62,82 +63,89 @@ SqlEventStoreConfig entity serialized -> Entity entity -> GlobalStreamEvent serialized -sqlEventToGlobalStream config@SqlEventStoreConfig {..} (Entity key event) = - StreamEvent () (sqlEventStoreConfigUnKey key) (sqlEventToVersioned config event) +sqlEventToGlobalStream config (Entity eKey event) = + let versioned = sqlEventToVersioned config event + in StreamEvent () (config.unKey eKey) versioned.metadata versioned +-- | Decode metadata from a stored JSONString. Returns empty metadata on NULL +-- or decode failure, ensuring events are always readable. +decodeMetadata :: Maybe JSONString -> EventMetadata +decodeMetadata = fromMaybe (emptyMetadata "") . (>>= decodeJSON) + sqlEventToVersioned :: SqlEventStoreConfig entity serialized -> entity -> VersionedStreamEvent serialized -sqlEventToVersioned SqlEventStoreConfig {..} entity = +sqlEventToVersioned config entity = StreamEvent - (sqlEventStoreConfigUUID entity) - (sqlEventStoreConfigVersion entity) - (sqlEventStoreConfigData entity) + (config.uuid entity) + (config.version entity) + (decodeMetadata $ config.metadata entity) + (config.payload entity) sqlGetProjectionIds :: - (MonadIO m, PersistEntity entity, PersistEntityBackend entity ~ SqlBackend) => + (MonadIO m, PersistEntity entity) => SqlEventStoreConfig entity serialized -> SqlPersistT m [UUID] -sqlGetProjectionIds SqlEventStoreConfig {..} = +sqlGetProjectionIds config = fmap unSingle <$> rawSql ("SELECT DISTINCT " <> uuidFieldName <> " FROM " <> tableName) [] where - tableName = unEntityNameDB $ tableDBName (sqlEventStoreConfigSequenceMakeEntity nil 0 undefined) - uuidFieldName = unFieldNameDB $ fieldDBName sqlEventStoreConfigSequenceNumberField + tableName = unEntityNameDB $ tableDBName (config.sequenceMakeEntity nil 0 undefined Nothing) + uuidFieldName = unFieldNameDB $ fieldDBName config.uuidField sqlGetStreamEvents :: (MonadIO m, PersistEntity entity, PersistEntityBackend entity ~ SqlBackend) => SqlEventStoreConfig entity serialized -> QueryRange UUID EventVersion -> SqlPersistT m [VersionedStreamEvent serialized] -sqlGetStreamEvents config@SqlEventStoreConfig {..} QueryRange {..} = do +sqlGetStreamEvents config query = do entities <- selectList filters selectOpts return $ sqlEventToVersioned config . entityVal <$> entities where startFilter = - case queryRangeStart of + case query.start of StartFromBeginning -> [] - StartQueryAt start -> [sqlEventStoreConfigVersionField >=. start] + StartQueryAt s -> [config.versionField >=. s] (endFilter, endSelectOpt) = - case queryRangeLimit of + case query.limit of NoQueryLimit -> ([], []) MaxNumberOfEvents maxNum -> ([], [LimitTo maxNum]) - StopQueryAt stop -> ([sqlEventStoreConfigVersionField <=. stop], []) - filters = (sqlEventStoreConfigUUIDField ==. queryRangeKey) : startFilter ++ endFilter - selectOpts = Asc sqlEventStoreConfigSequenceNumberField : endSelectOpt + StopQueryAt stop -> ([config.versionField <=. stop], []) + filters = (config.uuidField ==. query.key) : startFilter ++ endFilter + selectOpts = Asc config.sequenceNumberField : endSelectOpt sqlGetAllEventsInRange :: (MonadIO m, PersistEntity entity, PersistEntityBackend entity ~ SqlBackend) => SqlEventStoreConfig entity serialized -> QueryRange () SequenceNumber -> SqlPersistT m [GlobalStreamEvent serialized] -sqlGetAllEventsInRange config@SqlEventStoreConfig {..} QueryRange {..} = do +sqlGetAllEventsInRange config query = do entities <- selectList filters selectOpts return $ sqlEventToGlobalStream config <$> entities where startFilter = - case queryRangeStart of + case query.start of StartFromBeginning -> [] - StartQueryAt start -> [sqlEventStoreConfigSequenceNumberField >=. sqlEventStoreConfigMakeKey start] + StartQueryAt s -> [config.sequenceNumberField >=. config.makeKey s] (endFilter, endSelectOpt) = - case queryRangeLimit of + case query.limit of NoQueryLimit -> ([], []) MaxNumberOfEvents maxNum -> ([], [LimitTo maxNum]) - StopQueryAt stop -> ([sqlEventStoreConfigSequenceNumberField <=. sqlEventStoreConfigMakeKey stop], []) + StopQueryAt stop -> ([config.sequenceNumberField <=. config.makeKey stop], []) filters = startFilter ++ endFilter - selectOpts = Asc sqlEventStoreConfigSequenceNumberField : endSelectOpt + selectOpts = Asc config.sequenceNumberField : endSelectOpt sqlMaxEventVersion :: - (MonadIO m, PersistEntity entity, PersistEntityBackend entity ~ SqlBackend) => + (MonadIO m, PersistEntity entity) => 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] +sqlMaxEventVersion config maxVersionSql uid = + let tableName = FieldNameDB $ unEntityNameDB $ tableDBName (config.sequenceMakeEntity nil 0 undefined Nothing) + uuidFieldName = fieldDBName config.uuidField + versionFieldName = fieldDBName config.versionField + rawVals = rawSql (maxVersionSql tableName uuidFieldName versionFieldName) [toPersistValue uid] in maybe 0 unSingle . listToMaybe <$> rawVals sqlStoreEvents :: @@ -148,17 +156,46 @@ 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 +sqlStoreEvents config mLockCommand maxVersionSql uid events = do + versionNum <- sqlMaxEventVersion config maxVersionSql uid + let entities = zipWith (\v e -> config.sequenceMakeEntity uid v e Nothing) [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) + tableName = unEntityNameDB $ tableDBName (config.sequenceMakeEntity nil 0 undefined Nothing) +-- | Like 'sqlStoreEvents' but accepts 'TaggedEvent's, using their metadata +-- for event type name, correlation ID, causation ID, and timestamp. +sqlStoreEventsTagged :: + (MonadIO m, PersistEntity entity, PersistEntityBackend entity ~ SqlBackend, SafeToInsert entity) => + SqlEventStoreConfig entity serialized -> + Maybe (Text -> Text) -> + (FieldNameDB -> FieldNameDB -> FieldNameDB -> Text) -> + UUID -> + [TaggedEvent serialized] -> + SqlPersistT m EventVersion +sqlStoreEventsTagged config mLockCommand maxVersionSql uid taggedEvents = do + versionNum <- sqlMaxEventVersion config maxVersionSql uid + let entities = + zipWith + ( \v (TaggedEvent meta e) -> + config.sequenceMakeEntity + uid + v + e + (Just $ encodeJSON meta) + ) + [versionNum + 1 ..] + taggedEvents + for_ mLockCommand $ \lockCommand -> rawExecute (lockCommand tableName) [] + _ <- insertMany entities + return $ versionNum + EventVersion (length taggedEvents) + where + tableName = unEntityNameDB $ tableDBName (config.sequenceMakeEntity nil 0 undefined Nothing) + -- | 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 @@ -168,10 +205,15 @@ SqlEventStoreConfig entity serialized -> [GlobalStreamEvent serialized] -> SqlPersistT m () -unsafeSqlStoreGlobalStreamEvents SqlEventStoreConfig {..} events = +unsafeSqlStoreGlobalStreamEvents config events = insertEntityMany $ fmap mkEventEntity events where - mkEventEntity (StreamEvent () seqNum (StreamEvent uuid vers event)) = + mkEventEntity (StreamEvent () seqNum _ (StreamEvent uid vers meta evtPayload)) = Entity - (sqlEventStoreConfigMakeKey seqNum) - (sqlEventStoreConfigSequenceMakeEntity uuid vers event) + (config.makeKey seqNum) + ( config.sequenceMakeEntity + uid + vers + evtPayload + (Just $ encodeJSON meta) + ) diff --git a/src/Eventium/Store/Sql/Orphans.hs b/src/Eventium/Store/Sql/Orphans.hs --- a/src/Eventium/Store/Sql/Orphans.hs +++ b/src/Eventium/Store/Sql/Orphans.hs @@ -6,7 +6,6 @@ ) where -import qualified Data.ByteString as BS import Data.Proxy import qualified Data.Text as T import qualified Data.Text.Encoding as TE @@ -24,8 +23,6 @@ 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) @@ -34,14 +31,14 @@ sqlType _ = SqlOther "uuid" instance PersistField EventVersion where - toPersistValue = toPersistValue . unEventVersion + toPersistValue (EventVersion n) = toPersistValue n fromPersistValue = fmap EventVersion . fromPersistValue instance PersistFieldSql EventVersion where sqlType _ = sqlType (Proxy :: Proxy Int) instance PersistField SequenceNumber where - toPersistValue = toPersistValue . unSequenceNumber + toPersistValue (SequenceNumber n) = toPersistValue n fromPersistValue = fmap SequenceNumber . fromPersistValue instance PersistFieldSql SequenceNumber where