diff --git a/CHANGELOG.md b/CHANGELOG.md new file mode 100644 --- /dev/null +++ b/CHANGELOG.md @@ -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 diff --git a/LICENSE.md b/LICENSE.md new file mode 100644 --- /dev/null +++ b/LICENSE.md @@ -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 diff --git a/README.md b/README.md new file mode 100644 --- /dev/null +++ b/README.md @@ -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 diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -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: . +import qualified Distribution.Simple + +main :: IO () +main = Distribution.Simple.defaultMain diff --git a/eventsource-geteventstore-store.cabal b/eventsource-geteventstore-store.cabal new file mode 100644 --- /dev/null +++ b/eventsource-geteventstore-store.cabal @@ -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 diff --git a/library/EventSource/Store/GetEventStore.hs b/library/EventSource/Store/GetEventStore.hs new file mode 100644 --- /dev/null +++ b/library/EventSource/Store/GetEventStore.hs @@ -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 +-- 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 diff --git a/package.yaml b/package.yaml new file mode 100644 --- /dev/null +++ b/package.yaml @@ -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: . +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' diff --git a/stack.yaml b/stack.yaml new file mode 100644 --- /dev/null +++ b/stack.yaml @@ -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 diff --git a/test-suite/Main.hs b/test-suite/Main.hs new file mode 100644 --- /dev/null +++ b/test-suite/Main.hs @@ -0,0 +1,21 @@ +-------------------------------------------------------------------------------- +-- | +-- Module : Main +-- Copyright : (C) 2016 Yorick Laupa +-- License : (see the file LICENSE) +-- +-- Maintainer : Yorick Laupa +-- 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) diff --git a/test-suite/Test/EventSource/Store/GetEventStore.hs b/test-suite/Test/EventSource/Store/GetEventStore.hs new file mode 100644 --- /dev/null +++ b/test-suite/Test/EventSource/Store/GetEventStore.hs @@ -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 +-- 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