eventsource-geteventstore-store (empty) → 1.0.0

raw patch · 10 files changed

+431/−0 lines, 10 filesdep +aesondep +basedep +eventsource-apisetup-changed

Dependencies added: aeson, base, eventsource-api, eventsource-geteventstore-store, eventsource-store-specs, eventstore, mtl, protolude, tasty, tasty-hspec

Files

• CHANGELOG.md +7/−0
• LICENSE.md +34/−0
• README.md +11/−0
• Setup.hs +7/−0
• eventsource-geteventstore-store.cabal +63/−0
• library/EventSource/Store/GetEventStore.hs +141/−0
• package.yaml +48/−0
• stack.yaml +66/−0
• test-suite/Main.hs +21/−0
• test-suite/Test/EventSource/Store/GetEventStore.hs +33/−0

@@ -0,0 +1,7 @@+# Change log++geteventstore-store uses [Semantic Versioning][].+The change log is available through the [releases on GitHub][].++[Semantic Versioning]: http://semver.org/spec/v2.0.0.html+[releases on GitHub]: https://github.com/githubuser/geteventstore-store/releases

@@ -0,0 +1,34 @@+[The BSD-3 License (BSD3)][]++Copyright (c) 2016, Yorick Laupa++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++    * Redistributions of source code must retain the above copyright+      notice, this list of conditions and the following disclaimer.++    * Redistributions in binary form must reproduce the above+      copyright notice, this list of conditions and the following+      disclaimer in the documentation and/or other materials provided+      with the distribution.++    * Neither the name of Yorick Laupa nor the names of other+      contributors may be used to endorse or promote products derived+      from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.++[The BSD-3 License (BSD3)]: https://opensource.org/licenses/BSD-3-Clause

@@ -0,0 +1,11 @@+# [eventsource-geteventstore-store][]++[GetEventStore][] `Store` implementation. It's based on [eventstore][] driver.++##### Testing++In order to run the tests, you'll need a running [GetEventStore][] server at `localhost` on the `1113` port.++[eventsource-geteventstore-store]: https://github.com/YoEight/eventsource-api+[GetEventStore]: http://geteventstore.com+[eventstore]: https://github.com/YoEight/eventstore

@@ -0,0 +1,7 @@+-- This script is used to build and install your package. Typically you don't+-- need to change it. The Cabal documentation has more information about this+-- file: <https://www.haskell.org/cabal/users-guide/installing-packages.html>.+import qualified Distribution.Simple++main :: IO ()+main = Distribution.Simple.defaultMain

@@ -0,0 +1,63 @@+-- This file has been generated from package.yaml by hpack version 0.15.0.+--+-- see: https://github.com/sol/hpack++name:           eventsource-geteventstore-store+version:        1.0.0+synopsis:       GetEventStore store implementation.+description:    GetEventStore store implementation.+category:       Eventsourcing+homepage:       https://github.com/YoEight/eventsource-api#readme+bug-reports:    https://github.com/YoEight/eventsource-api/issues+author:         Yorick Laupa+maintainer:     yo.eight@gmail.comm+license:        BSD3+license-file:   LICENSE.md+build-type:     Simple+cabal-version:  >= 1.10++extra-source-files:+    CHANGELOG.md+    LICENSE.md+    package.yaml+    README.md+    stack.yaml++source-repository head+  type: git+  location: https://github.com/YoEight/eventsource-api++library+  hs-source-dirs:+      library+  default-extensions: NoImplicitPrelude+  ghc-options: -Wall+  build-depends:+      base >=4.9 && <5+    , protolude >=0.1.10 && <0.2+    , eventstore ==0.14.*+    , eventsource-api ==1.*+    , aeson+    , mtl+  exposed-modules:+      EventSource.Store.GetEventStore+  default-language: Haskell2010++test-suite geteventstore-store-test-suite+  type: exitcode-stdio-1.0+  main-is: Main.hs+  hs-source-dirs:+      test-suite+  ghc-options: -Wall -rtsopts -threaded -with-rtsopts=-N+  build-depends:+      base+    , eventsource-geteventstore-store+    , eventsource-api+    , eventsource-store-specs ==1.*+    , eventstore+    , tasty+    , tasty-hspec+    , protolude+  other-modules:+      Test.EventSource.Store.GetEventStore+  default-language: Haskell2010

@@ -0,0 +1,141 @@+{-# LANGUAGE GADTs             #-}+{-# LANGUAGE OverloadedStrings #-}+--------------------------------------------------------------------------------+-- |+-- Module : EventSource.Store.GetEventStore+-- Copyright : (C) 2016 Yorick Laupa+-- License : (see the file LICENSE)+--+-- Maintainer : Yorick Laupa <yo.eight@gmail.com>+-- Stability : provisional+-- Portability : non-portable+--+-- This module exposes a GetEventStore implementation of Store interface.+--------------------------------------------------------------------------------+module EventSource.Store.GetEventStore+  ( GetEventStore+  , gesConnection+  , gesStore+  ) where++--------------------------------------------------------------------------------+import           Protolude+import           Data.Aeson+import           Data.Aeson.Types+import qualified Database.EventStore as GES+import           EventSource++--------------------------------------------------------------------------------+newtype GetEventStore = GetEventStore { gesConnection :: GES.Connection }++--------------------------------------------------------------------------------+toGesExpVer :: ExpectedVersion -> GES.ExpectedVersion+toGesExpVer AnyVersion = GES.anyVersion+toGesExpVer NoStream = GES.noStreamVersion+toGesExpVer StreamExists = GES.streamExists+toGesExpVer (ExactVersion n) =+  let EventNumber i = n in+  GES.exactEventVersion i++--------------------------------------------------------------------------------+buildEvent :: (EncodeEvent a, MonadIO m) => a -> m Event+buildEvent a = do+  eid <- freshEventId+  let start = Event { eventType = ""+                    , eventId = eid+                    , eventPayload = dataFromBytes ""+                    , eventMetadata = Nothing+                    }++  return $ execState (encodeEvent a) start++--------------------------------------------------------------------------------+makeEvent :: EncodeEvent a => a -> IO GES.Event+makeEvent a = toGesEvent <$> buildEvent a++--------------------------------------------------------------------------------+toGesEvent :: Event -> GES.Event+toGesEvent e = GES.createEvent (GES.UserDefined typ) (Just eid) eventData+  where+    EventType typ = eventType e+    EventId eid = eventId e++    eventData =+      case eventMetadata e of+        Nothing ->+          case eventPayload e of+            Data bs -> GES.withBinary bs+            DataAsJson v -> GES.withJson v+        Just p ->+          case eventPayload e of+            Data bs -> GES.withBinaryAndMetadata bs (toS $ encode p)+            DataAsJson v -> GES.withJsonAndMetadata v p++--------------------------------------------------------------------------------+fromGesEvent :: GES.ResolvedEvent -> SavedEvent+fromGesEvent e = saved+  where+    re = GES.resolvedEventOriginal e+    eid = EventId $ GES.recordedEventId re+    etyp = EventType $ GES.recordedEventType re+    num = GES.recordedEventNumber re+    payload = GES.recordedEventData re+    metaBytes = GES.recordedEventMetadata re+    event = Event { eventType = etyp+                  , eventId = eid+                  , eventPayload = dataFromBytes payload+                  , eventMetadata = decodeStrict =<< metaBytes+                  }+    saved = SavedEvent { eventNumber = EventNumber num+                       , savedEvent = event+                       }++--------------------------------------------------------------------------------+fromGesSlice :: GES.StreamSlice -> Slice+fromGesSlice s = Slice { sliceEvents = fromGesEvent <$> GES.sliceEvents s+                       , sliceEndOfStream = GES.sliceEOS s+                       , sliceNextEventNumber = EventNumber $ GES.sliceNext s+                       }++--------------------------------------------------------------------------------+fromGesReadResult :: GES.ReadResult t a -> ReadStatus a+fromGesReadResult (GES.ReadSuccess a) =+  ReadSuccess a+fromGesReadResult GES.ReadNoStream =+  ReadFailure StreamNotFound+fromGesReadResult (GES.ReadStreamDeleted _) =+  ReadFailure StreamNotFound+fromGesReadResult GES.ReadNotModified =+  ReadFailure (ReadError $ Just "not modified")+fromGesReadResult (GES.ReadError e) =+  ReadFailure $ ReadError e+fromGesReadResult (GES.ReadAccessDenied _) =+  ReadFailure AccessDenied++--------------------------------------------------------------------------------+defaultBatchSize :: Int32+defaultBatchSize = 500++--------------------------------------------------------------------------------+instance Store GetEventStore where+  appendEvents (GetEventStore conn) (StreamName name) ver xs = liftIO $ do+    events <- traverse makeEvent xs+    w <- GES.sendEvents conn name (toGesExpVer ver) events+    return $ fmap (EventNumber . GES.writeNextExpectedVersion) w++  readBatch (GetEventStore conn) (StreamName name) b = liftIO $ do+    let EventNumber n = batchFrom b+    w <- GES.readStreamEventsForward conn name n (batchSize b) True+    return $ fmap (fmap fromGesSlice . fromGesReadResult) w++  subscribe (GetEventStore conn) (StreamName name) = liftIO $ do+    sub <- GES.subscribe conn name True+    sid <- freshSubscriptionId++    return $ Subscription sid $ liftIO $+      try $ fmap fromGesEvent $ GES.nextEvent sub++--------------------------------------------------------------------------------+-- | Returns a GetEventStore based store implementation.+gesStore :: GES.Settings -> GES.ConnectionType -> IO GetEventStore+gesStore setts typ = fmap GetEventStore $ GES.connect setts typ

@@ -0,0 +1,48 @@+# This YAML file describes your package. Stack will automatically generate a+# Cabal file when you run `stack build`. See the hpack website for help with+# this file: <https://github.com/sol/hpack>.+category: Eventsourcing+description: GetEventStore store implementation.+extra-source-files:+- CHANGELOG.md+- LICENSE.md+- package.yaml+- README.md+- stack.yaml+ghc-options: -Wall+github: YoEight/eventsource-api+library:+  default-extensions:+    - NoImplicitPrelude+  dependencies:+  - base >=4.9 && <5+  - protolude >=0.1.10 && <0.2+  - eventstore ==0.14.*+  - eventsource-api ==1.*+  - aeson+  - mtl+  source-dirs: library+license: BSD3+license-file: LICENSE.md+author: Yorick Laupa+maintainer: yo.eight@gmail.comm+name: eventsource-geteventstore-store+synopsis: GetEventStore store implementation.+tests:+  geteventstore-store-test-suite:+    dependencies:+    - base+    - eventsource-geteventstore-store+    - eventsource-api+    - eventsource-store-specs ==1.*+    - eventstore+    - tasty+    - tasty-hspec+    - protolude+    ghc-options:+    - -rtsopts+    - -threaded+    - -with-rtsopts=-N+    main: Main.hs+    source-dirs: test-suite+version: '1.0.0'

@@ -0,0 +1,66 @@+# This file was automatically generated by 'stack init'+#+# Some commonly used options have been documented as comments in this file.+# For advanced use and comprehensive documentation of the format, please see:+# http://docs.haskellstack.org/en/stable/yaml_configuration/++# Resolver to choose a 'specific' stackage snapshot or a compiler version.+# A snapshot resolver dictates the compiler version and the set of packages+# to be used for project dependencies. For example:+#+# resolver: lts-3.5+# resolver: nightly-2015-09-21+# resolver: ghc-7.10.2+# resolver: ghcjs-0.1.0_ghc-7.10.2+# resolver:+#  name: custom-snapshot+#  location: "./custom-snapshot.yaml"+resolver: lts-7.14++# User packages to be built.+# Various formats can be used as shown in the example below.+#+# packages:+# - some-directory+# - https://example.com/foo/bar/baz-0.0.2.tar.gz+# - location:+#    git: https://github.com/commercialhaskell/stack.git+#    commit: e7b331f14bcffb8367cd58fbfc8b40ec7642100a+# - location: https://github.com/commercialhaskell/stack/commit/e7b331f14bcffb8367cd58fbfc8b40ec7642100a+#   extra-dep: true+#  subdirs:+#  - auto-update+#  - wai+#+# A package marked 'extra-dep: true' will only be built if demanded by a+# non-dependency (i.e. a user package), and its test suites and benchmarks+# will not be run. This is useful for tweaking upstream packages.+packages:+- '.'+# Dependency packages to be pulled from upstream that are not in the resolver+# (e.g., acme-missiles-0.3)+extra-deps: []++# Override default flag values for local packages and extra-deps+flags: {}++# Extra package databases containing global packages+extra-package-dbs: []++# Control whether we use the GHC we find on the path+# system-ghc: true+#+# Require a specific version of stack, using version ranges+# require-stack-version: -any # Default+# require-stack-version: ">=1.2"+#+# Override the architecture used by stack, especially useful on Windows+# arch: i386+# arch: x86_64+#+# Extra directories used by stack for building+# extra-include-dirs: [/path/to/dir]+# extra-lib-dirs: [/path/to/dir]+#+# Allow a newer minor version of GHC than the snapshot specifies+# compiler-check: newer-minor

@@ -0,0 +1,21 @@+--------------------------------------------------------------------------------+-- |+-- Module : Main+-- Copyright : (C) 2016 Yorick Laupa+-- License : (see the file LICENSE)+--+-- Maintainer : Yorick Laupa <yo.eight@gmail.com>+-- Stability : provisional+-- Portability : non-portable+--+--------------------------------------------------------------------------------+import qualified Test.Tasty++--------------------------------------------------------------------------------+import qualified Test.EventSource.Store.GetEventStore as GES++--------------------------------------------------------------------------------+main :: IO ()+main = do+    tree <- sequence [ GES.test ]+    Test.Tasty.defaultMain (Test.Tasty.testGroup "EventSource API" tree)

@@ -0,0 +1,33 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RecordWildCards   #-}+--------------------------------------------------------------------------------+-- |+-- Module : Test.EventSource.Store.GetEventStore+-- Copyright : (C) 2016 Yorick Laupa+-- License : (see the file LICENSE)+--+-- Maintainer : Yorick Laupa <yo.eight@gmail.com>+-- Stability : provisional+-- Portability : non-portable+--+--------------------------------------------------------------------------------+module Test.EventSource.Store.GetEventStore (test) where++--------------------------------------------------------------------------------+import Database.EventStore+import EventSource.Store.GetEventStore+import Test.Tasty (TestTree)+import Test.Tasty.Hspec++--------------------------------------------------------------------------------+import Test.EventSource.Store.Specification++--------------------------------------------------------------------------------+test :: IO TestTree+test = testSpec "Store GetEventStore" spec++--------------------------------------------------------------------------------+spec :: Spec+spec = parallel $ do+  ges <- runIO $ gesStore defaultSettings (Static "127.0.0.1" 1113)+  specification ges