eventful-postgresql (empty) → 0.1.0

raw patch · 8 files changed

+230/−0 lines, 8 filesdep +HUnitdep +aesondep +base

Dependencies added: HUnit, aeson, base, bytestring, eventful-core, eventful-sql-common, eventful-test-helpers, hlint, hspec, mtl, persistent, persistent-postgresql, text

Files

• CHANGELOG.md +0/−0
• LICENSE.md +19/−0
• README.md +1/−0
• eventful-postgresql.cabal +88/−0
• src/Eventful/Store/Postgresql.hs +44/−0
• tests/Eventful/Store/PostgresqlSpec.hs +58/−0
• tests/HLint.hs +19/−0
• tests/Spec.hs +1/−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,1 @@+# Eventful postgresql

@@ -0,0 +1,88 @@+-- This file has been generated from package.yaml by hpack version 0.17.0.+--+-- see: https://github.com/sol/hpack++name:           eventful-postgresql+version:        0.1.0+synopsis:       Postgres implementations for eventful+description:    Postgres implementations for eventful+category:       Database,Eventsourcing,PostgreSQL+stability:      experimental+maintainer:     David Reaver+license:        MIT+license-file:   LICENSE.md+build-type:     Simple+cabal-version:  >= 1.10++extra-source-files:+    CHANGELOG.md+    README.md++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+    , eventful-sql-common+    , aeson+    , bytestring+    , mtl+    , persistent+    , persistent-postgresql+    , text+  exposed-modules:+      Eventful.Store.Postgresql+  default-language: Haskell2010++test-suite spec+  type: exitcode-stdio-1.0+  main-is: Spec.hs+  hs-source-dirs:+      tests+      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+    , eventful-sql-common+    , aeson+    , bytestring+    , mtl+    , persistent+    , persistent-postgresql+    , text+    , hspec+    , HUnit+    , eventful-test-helpers+  other-modules:+      Eventful.Store.PostgresqlSpec+      HLint+      Eventful.Store.Postgresql+  default-language: Haskell2010++test-suite style+  type: exitcode-stdio-1.0+  main-is: HLint.hs+  hs-source-dirs:+      tests+  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+    , eventful-sql-common+    , aeson+    , bytestring+    , mtl+    , persistent+    , persistent-postgresql+    , text+    , hlint+  other-modules:+      Eventful.Store.PostgresqlSpec+      Spec+  default-language: Haskell2010

@@ -0,0 +1,44 @@+-- | Defines an Postgresql event store.++module Eventful.Store.Postgresql+  ( postgresqlEventStore+  , initializePostgresqlEventStore+  , module Eventful.Store.Class+  , module Eventful.Store.Sql+  ) where++import Control.Monad.Reader+import Data.Monoid ((<>))+import Data.Text (Text)+import Database.Persist+import Database.Persist.Sql++import Eventful.Store.Class+import Eventful.Store.Sql++-- | An 'EventStore' that uses a PostgreSQL database as a backend. Use+-- 'SqlEventStoreConfig' to configure this event store.+postgresqlEventStore+  :: (MonadIO m, PersistEntity entity, PersistEntityBackend entity ~ SqlBackend)+  => SqlEventStoreConfig entity serialized+  -> EventStore serialized (SqlPersistT m)+postgresqlEventStore config =+  let+    getLatestVersion = sqlMaxEventVersion config maxPostgresVersionSql+    getEvents = sqlGetAggregateEvents config+    storeEvents' = sqlStoreEvents config maxPostgresVersionSql+    storeEvents = transactionalExpectedWriteHelper getLatestVersion storeEvents'+  in EventStore{..}++maxPostgresVersionSql :: DBName -> DBName -> DBName -> Text+maxPostgresVersionSql (DBName tableName) (DBName uuidFieldName) (DBName versionFieldName) =+  "SELECT COALESCE(MAX(" <> versionFieldName <> "), -1) FROM " <> tableName <> " WHERE " <> uuidFieldName <> " = ?"++-- | This function runs migrations to create the events table if it isn't+-- present.+initializePostgresqlEventStore :: (MonadIO m) => ConnectionPool -> m ()+initializePostgresqlEventStore pool = do+  -- Run migrations+  _ <- liftIO $ runSqlPool (runMigrationSilent migrateSqlEvent) pool++  return ()

@@ -0,0 +1,58 @@+module Eventful.Store.PostgresqlSpec (spec) where++import Control.Monad.Reader (ask)+import Data.Monoid ((<>))+import Data.Text (Text, intercalate)+import Database.Persist.Postgresql+import Test.Hspec++import Eventful.Serializer+import Eventful.Store.Postgresql+import Eventful.TestHelpers++makeStore :: (MonadIO m) => m (EventStore CounterEvent (SqlPersistT m), ConnectionPool)+makeStore = do+  -- TODO: Obviously this is hard-coded, make this use environment variables or+  -- something in the future.+  let+    connString = "host=localhost port=5432 user=postgres dbname=eventful_test password=password"+    store = postgresqlEventStore defaultSqlEventStoreConfig+    store' = serializedEventStore jsonStringSerializer store+  pool <- liftIO $ runNoLoggingT (createPostgresqlPool connString 1)+  initializePostgresqlEventStore pool+  liftIO $ runSqlPool truncateTables pool+  return (store', pool)++getTables :: MonadIO m => SqlPersistT m [Text]+getTables = do+    tables <-+      rawSql+      "SELECT table_name FROM information_schema.tables WHERE table_schema = 'public' AND table_type = 'BASE TABLE';"+      []+    return $ map unSingle tables++truncateTables :: MonadIO m => SqlPersistT m ()+truncateTables = do+    tables <- getTables+    sqlBackend <- ask+    let+      escapedTables = map (connEscapeName sqlBackend . DBName) tables+      query = "TRUNCATE TABLE " <> intercalate ", " escapedTables <> " RESTART IDENTITY CASCADE"+    rawExecute query []++makeGlobalStore+  :: (MonadIO m)+  => m (EventStore CounterEvent (SqlPersistT m), GloballyOrderedEventStore CounterEvent (SqlPersistT m), ConnectionPool)+makeGlobalStore = do+  (store, pool) <- makeStore+  let+    globalStore = sqlGloballyOrderedEventStore defaultSqlEventStoreConfig+    globalStore' = serializedGloballyOrderedEventStore jsonStringSerializer globalStore+  return (store, globalStore', pool)+++spec :: Spec+spec = do+  describe "Postgresql event store" $ do+    eventStoreSpec makeStore (flip runSqlPool)+    sequencedEventStoreSpec makeGlobalStore (flip runSqlPool)

@@ -0,0 +1,19 @@+module Main (main) where++import Language.Haskell.HLint (hlint)+import System.Exit (exitFailure, exitSuccess)++import Prelude (String, IO, null)++arguments :: [String]+arguments =+    [ "src"+    , "tests"+    , "-i=Redundant do"+    , "-i=Unused LANGUAGE pragma" -- This fails on DeriveGeneric+    ]++main :: IO ()+main = do+    hints <- hlint arguments+    if null hints then exitSuccess else exitFailure

@@ -0,0 +1,1 @@+{-# OPTIONS_GHC -F -pgmF hspec-discover #-}