eventful-sqlite (empty) → 0.1.0

raw patch · 8 files changed

+219/−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-sqlite, text, uuid

Files

• CHANGELOG.md +0/−0
• LICENSE.md +19/−0
• README.md +1/−0
• eventful-sqlite.cabal +91/−0
• src/Eventful/Store/Sqlite.hs +59/−0
• tests/Eventful/Store/SqliteSpec.hs +29/−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 sqlite

@@ -0,0 +1,91 @@+-- This file has been generated from package.yaml by hpack version 0.17.0.+--+-- see: https://github.com/sol/hpack++name:           eventful-sqlite+version:        0.1.0+synopsis:       SQLite implementations for eventful+description:    SQLite implementations for eventful+category:       Database,Eventsourcing,SQLite+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-sqlite+    , text+    , uuid+  exposed-modules:+      Eventful.Store.Sqlite+  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-sqlite+    , text+    , uuid+    , hspec+    , HUnit+    , eventful-test-helpers+  other-modules:+      Eventful.Store.SqliteSpec+      HLint+      Eventful.Store.Sqlite+  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-sqlite+    , text+    , uuid+    , hlint+  other-modules:+      Eventful.Store.SqliteSpec+      Spec+  default-language: Haskell2010

@@ -0,0 +1,59 @@+-- | Defines an Sqlite event store.++module Eventful.Store.Sqlite+  ( sqliteEventStore+  , initializeSqliteEventStore+  , 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 an SQLite database as a backend. Use+-- 'SqlEventStoreConfig' to configure this event store.+sqliteEventStore+  :: (MonadIO m, PersistEntity entity, PersistEntityBackend entity ~ SqlBackend)+  => SqlEventStoreConfig entity serialized+  -> EventStore serialized (SqlPersistT m)+sqliteEventStore config =+  let+    getLatestVersion = sqlMaxEventVersion config maxSqliteVersionSql+    getEvents = sqlGetAggregateEvents config+    storeEvents' = sqlStoreEvents config maxSqliteVersionSql+    storeEvents = transactionalExpectedWriteHelper getLatestVersion storeEvents'+  in EventStore{..}++maxSqliteVersionSql :: DBName -> DBName -> DBName -> Text+maxSqliteVersionSql (DBName tableName) (DBName uuidFieldName) (DBName versionFieldName) =+  "SELECT IFNULL(MAX(" <> versionFieldName <> "), -1) FROM " <> tableName <> " WHERE " <> uuidFieldName <> " = ?"++-- | This functions runs the migrations required to create the events table and+-- also adds an index on the UUID column.+initializeSqliteEventStore+  :: (MonadIO m, PersistEntity entity, PersistEntityBackend entity ~ SqlBackend)+  => SqlEventStoreConfig entity serialized+  -> ConnectionPool+  -> m ()+initializeSqliteEventStore SqlEventStoreConfig{..} pool = do+  -- Run migrations+  _ <- liftIO $ runSqlPool (runMigrationSilent migrateSqlEvent) pool++  -- Create index on uuid field so retrieval is very fast+  let+    (DBName tableName) = tableDBName (sqlEventStoreConfigSequenceMakeEntity undefined undefined undefined)+    (DBName uuidFieldName) = fieldDBName sqlEventStoreConfigSequenceNumberField+    indexSql =+      "CREATE INDEX IF NOT EXISTS " <>+      uuidFieldName <> "_index" <>+      " ON " <> tableName <>+      " (" <> uuidFieldName <> ")"+  liftIO $ flip runSqlPool pool $ rawExecute indexSql []++  return ()

@@ -0,0 +1,29 @@+module Eventful.Store.SqliteSpec (spec) where++import Database.Persist.Sqlite+import Test.Hspec++import Eventful.Serializer+import Eventful.Store.Sqlite+import Eventful.TestHelpers++makeStore :: (MonadIO m) => m (EventStore CounterEvent (SqlPersistT m), ConnectionPool)+makeStore = do+  pool <- liftIO $ runNoLoggingT (createSqlitePool ":memory:" 1)+  let store = serializedEventStore jsonStringSerializer $ sqliteEventStore defaultSqlEventStoreConfig+  initializeSqliteEventStore defaultSqlEventStoreConfig pool+  return (store, pool)++makeGlobalStore+  :: (MonadIO m)+  => m (EventStore CounterEvent (SqlPersistT m), GloballyOrderedEventStore CounterEvent (SqlPersistT m), ConnectionPool)+makeGlobalStore = do+  (store, pool) <- makeStore+  let globalStore = serializedGloballyOrderedEventStore jsonStringSerializer (sqlGloballyOrderedEventStore defaultSqlEventStoreConfig)+  return (store, globalStore, pool)++spec :: Spec+spec = do+  describe "Sqlite 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 #-}