eventful-sql-common (empty) → 0.1.0

raw patch · 7 files changed

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

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

Files

• LICENSE.md +19/−0
• eventful-sql-common.cabal +39/−0
• src/Eventful/Store/Sql.hs +8/−0
• src/Eventful/Store/Sql/DefaultEntity.hs +43/−0
• src/Eventful/Store/Sql/JSONString.hs +38/−0
• src/Eventful/Store/Sql/Operations.hs +123/−0
• src/Eventful/Store/Sql/Orphans.hs +43/−0

@@ -0,0 +1,19 @@+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.

@@ -0,0 +1,39 @@+-- This file has been generated from package.yaml by hpack version 0.17.0.+--+-- see: https://github.com/sol/hpack++name:           eventful-sql-common+version:        0.1.0+synopsis:       Common library for SQL event stores+description:    Common library for SQL event stores+category:       Database,Eventsourcing+stability:      experimental+maintainer:     David Reaver+license:        MIT+license-file:   LICENSE.md+build-type:     Simple+cabal-version:  >= 1.10++library+  hs-source-dirs:+      src+  default-extensions: ConstraintKinds DeriveFunctor DeriveGeneric FlexibleContexts FlexibleInstances FunctionalDependencies GADTs GeneralizedNewtypeDeriving MultiParamTypeClasses OverloadedStrings QuasiQuotes RankNTypes RecordWildCards ScopedTypeVariables StandaloneDeriving TemplateHaskell TupleSections TypeFamilies+  ghc-options: -Wall+  build-depends:+      base >= 4.9 && < 5+    , eventful-core+    , aeson+    , bytestring+    , mtl+    , persistent+    , persistent-template+    , split+    , text+    , uuid+  exposed-modules:+      Eventful.Store.Sql+      Eventful.Store.Sql.DefaultEntity+      Eventful.Store.Sql.JSONString+      Eventful.Store.Sql.Operations+      Eventful.Store.Sql.Orphans+  default-language: Haskell2010

@@ -0,0 +1,8 @@+module Eventful.Store.Sql+  ( module X+  ) where++import Eventful.Store.Sql.DefaultEntity as X+import Eventful.Store.Sql.JSONString as X+import Eventful.Store.Sql.Operations as X+import Eventful.Store.Sql.Orphans as X ()

@@ -0,0 +1,43 @@+{-# LANGUAGE QuasiQuotes #-}++-- | Definition for a default Entity to use with a SQL event store.++module Eventful.Store.Sql.DefaultEntity+  ( SqlEvent (..)+  , SqlEventId+  , migrateSqlEvent+  , defaultSqlEventStoreConfig+  ) where++import Database.Persist.TH++import Eventful.Store.Class+import Eventful.UUID++import Eventful.Store.Sql.Operations+import Eventful.Store.Sql.JSONString+import Eventful.Store.Sql.Orphans ()++share [mkPersist sqlSettings, mkMigrate "migrateSqlEvent"] [persistLowerCase|+SqlEvent sql=events+    Id SequenceNumber sql=sequence_number+    uuid UUID+    version EventVersion+    event JSONString+    UniqueAggregateVersion uuid version+    deriving Show+|]++defaultSqlEventStoreConfig :: SqlEventStoreConfig SqlEvent JSONString+defaultSqlEventStoreConfig =+  SqlEventStoreConfig+  SqlEvent+  SqlEventKey+  (\(SqlEventKey seqNum) -> seqNum)+  sqlEventUuid+  sqlEventVersion+  sqlEventEvent+  SqlEventId+  SqlEventUuid+  SqlEventVersion+  SqlEventEvent

@@ -0,0 +1,38 @@+module Eventful.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 Eventful.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

@@ -0,0 +1,123 @@+module Eventful.Store.Sql.Operations+  ( SqlEventStoreConfig (..)+  , sqlGloballyOrderedEventStore+  , sqlGetProjectionIds+  , sqlGetAggregateEvents+  , sqlMaxEventVersion+  , sqlStoreEvents+  ) where++import Control.Monad.Reader+import Data.Maybe (listToMaybe, maybe)+import Data.Monoid ((<>))+import Data.Text (Text)+import Database.Persist+import Database.Persist.Sql++import Eventful.Store.Class+import Eventful.UUID++import Eventful.Store.Sql.Orphans as X ()++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+  }++sqlGloballyOrderedEventStore+  :: (MonadIO m, PersistEntity entity, PersistEntityBackend entity ~ SqlBackend)+  => SqlEventStoreConfig entity serialized+  -> GloballyOrderedEventStore serialized (SqlPersistT m)+sqlGloballyOrderedEventStore config =+  GloballyOrderedEventStore $ sqlGetAllEventsFromSequence config++sqlEventToGloballyOrdered+  :: SqlEventStoreConfig entity serialized+  -> Entity entity+  -> GloballyOrderedEvent (StoredEvent serialized)+sqlEventToGloballyOrdered config@SqlEventStoreConfig{..} (Entity key event) =+  GloballyOrderedEvent (sqlEventStoreConfigUnKey key) $ sqlEventToStored config event++sqlEventToStored+  :: SqlEventStoreConfig entity serialized+  -> entity+  -> StoredEvent serialized+sqlEventToStored SqlEventStoreConfig{..} entity =+  StoredEvent+  (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+    (DBName tableName) = tableDBName (sqlEventStoreConfigSequenceMakeEntity nil 0 undefined)+    (DBName uuidFieldName) = fieldDBName sqlEventStoreConfigSequenceNumberField++sqlGetAggregateEvents+  :: (MonadIO m, PersistEntity entity, PersistEntityBackend entity ~ SqlBackend)+  => SqlEventStoreConfig entity serialized+  -> UUID+  -> Maybe EventVersion+  -> SqlPersistT m [StoredEvent serialized]+sqlGetAggregateEvents config@SqlEventStoreConfig{..} uuid mVers = do+  let+    constraints =+      (sqlEventStoreConfigUUIDField ==. uuid) :+      maybe [] (\vers -> [sqlEventStoreConfigVersionField >=. vers]) mVers+  entities <- selectList constraints [Asc sqlEventStoreConfigVersionField]+  return $ sqlEventToStored config . entityVal <$> entities++sqlGetAllEventsFromSequence+  :: (MonadIO m, PersistEntity entity, PersistEntityBackend entity ~ SqlBackend)+  => SqlEventStoreConfig entity serialized+  -> SequenceNumber+  -> SqlPersistT m [GloballyOrderedEvent (StoredEvent serialized)]+sqlGetAllEventsFromSequence config@SqlEventStoreConfig{..} seqNum = do+  entities <-+    selectList+    [sqlEventStoreConfigSequenceNumberField >=. sqlEventStoreConfigMakeKey seqNum]+    [Asc sqlEventStoreConfigSequenceNumberField]+  return $ sqlEventToGloballyOrdered config <$> entities++sqlMaxEventVersion+  :: (MonadIO m, PersistEntity entity, PersistEntityBackend entity ~ SqlBackend)+  => SqlEventStoreConfig entity serialized+  -> (DBName -> DBName -> DBName -> Text)+  -> UUID+  -> SqlPersistT m EventVersion+sqlMaxEventVersion SqlEventStoreConfig{..} maxVersionSql uuid =+  let+    tableName = 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)+  => SqlEventStoreConfig entity serialized+  -> (DBName -> DBName -> DBName -> Text)+  -> UUID+  -> [serialized]+  -> SqlPersistT m ()+sqlStoreEvents config@SqlEventStoreConfig{..} maxVersionSql uuid events = do+  versionNum <- sqlMaxEventVersion config maxVersionSql uuid+  let entities = zipWith (sqlEventStoreConfigSequenceMakeEntity uuid) [versionNum + 1..] events+  insertMany_ entities

@@ -0,0 +1,43 @@+{-# OPTIONS_GHC -fno-warn-orphans #-}++module Eventful.Store.Sql.Orphans+  (+  ) where++import Data.Proxy+import qualified Data.Text.Encoding as TE+import Data.UUID+import Database.Persist+import Database.Persist.Sql++import Eventful.Store.Class+import Eventful.UUID++instance PersistField UUID where+  toPersistValue = PersistText . uuidToText+  fromPersistValue (PersistDbSpecific t) =+    case uuidFromText (TE.decodeUtf8 t) of+      Just x -> Right x+      Nothing -> Left "Invalid UUID"+  fromPersistValue (PersistText t) =+    case uuidFromText t of+      Just x -> Right x+      Nothing -> Left "Invalid UUID"+  fromPersistValue _ = Left "Not PersistDBSpecific"++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)