eventsource-api (empty) → 1.0.0

raw patch · 10 files changed

+935/−0 lines, 10 filesdep +aesondep +basedep +containerssetup-changed

Dependencies added: aeson, base, containers, mtl, protolude, unordered-containers, uuid

Files

• CHANGELOG.md +7/−0
• LICENSE.md +34/−0
• README.md +60/−0
• Setup.hs +7/−0
• eventsource-api.cabal +47/−0
• library/EventSource.hs +19/−0
• library/EventSource/Store.hs +343/−0
• library/EventSource/Types.hs +320/−0
• package.yaml +32/−0
• stack.yaml +66/−0

@@ -0,0 +1,7 @@+# Change log++eventsource-api 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/eventsource-api/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,60 @@+# [eventsource-api][]++This project provides what we think be a lean eventsourcing API. The goal is to+set a common ground for eventsourcing-based application, yet doesn't force you+to be trapped under a restrictive framework.++This library main abstraction is the `Store` typeclass.++```haskell+-- | Main event store abstraction. It exposes essential features expected from+--   an event store.+class Store store where+  -- | Appends a batch of events at the end of a stream.+  appendEvents :: (EncodeEvent a, MonadIO m)+               => store+               -> StreamName+               -> ExpectedVersion+               -> [a]+               -> m (Async EventNumber)++  -- | Appends a batch of events at the end of a stream.+  readBatch :: MonadIO m+            => store+            -> StreamName+            -> Batch+            -> m (Async (ReadStatus Slice))++  -- | Subscribes to given stream.+  subscribe :: MonadIO m => store -> StreamName -> m Subscription+```++The idea is to use any backend of your liking as long as it's able to derive that typeclass with its related implicit constraints.++  1. `appendEvents` MUST add events at the end of a stream without doing any other alteration on the stream. The order of the event's array MUST be respected within the store. Most important, the implementation MUST comply to the given `ExpectedVersion` passed by the user.+  +  2. `readBatch` SHOULD retrieve a set of event given a starting position and a batch size (represented by the `Batch` parameter). The returned array MUST have its events ordered by their `EventNumber` property.++  3. `subscribe` SHOULD register a subscription to the given stream. An implementation MUST allow to subscribe to a stream that doesn't exist yet. A subscription allows the user to be notified of any event added to the stream. There is no mandatory timing to meet regarding how fast the subscription is notified by a change. We only suggest to dispatch new events as soon as possible.++#### `ExpectedVersion`++A word on `ExpectedVersion`. It's a mean to preserve data consistency in a concurrent setting.++```haskell+-- | The purpose of 'ExpectedVersion' is to make sure a certain stream state is+--   at an expected point in order to carry out a write.+data ExpectedVersion+  = AnyVersion+    -- Stream is a any given state.+  | NoStream+    -- Stream shouldn't exist.+  | StreamExists+    -- Stream should exist.+  | ExactVersion EventNumber+    -- Stream should be at givent event number.+```++On a write, if the `ExpectedVersion` condition given by the user is not met within the store, the implementation should raise an exception. At the moment, the API doesn't capture this situation in the type system.++[eventsource-api]: https://github.com/YoEight/eventsource-api

@@ -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,47 @@+-- This file has been generated from package.yaml by hpack version 0.15.0.+--+-- see: https://github.com/sol/hpack++name:           eventsource-api+version:        1.0.0+synopsis:       Provides a eventsourcing high level API.+description:    Please read README.md.+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.com+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+    , uuid+    , aeson+    , mtl+    , containers+    , unordered-containers+  exposed-modules:+      EventSource+      EventSource.Store+      EventSource.Types+  default-language: Haskell2010

@@ -0,0 +1,19 @@+--------------------------------------------------------------------------------+-- |+-- Module : EventSource+-- Copyright : (C) 2016 Yorick Laupa+-- License : (see the file LICENSE)+--+-- Maintainer : Yorick Laupa <yo.eight@gmail.com>+-- Stability : provisional+-- Portability : non-portable+--+--------------------------------------------------------------------------------+module EventSource+  ( module EventSource.Store+  , module EventSource.Types+  ) where++--------------------------------------------------------------------------------+import EventSource.Store+import EventSource.Types

@@ -0,0 +1,343 @@+{-# LANGUAGE ExistentialQuantification #-}+{-# LANGUAGE FlexibleContexts          #-}+{-# LANGUAGE Rank2Types                #-}+--------------------------------------------------------------------------------+-- |+-- Module : EventSource.Store+-- Copyright : (C) 2016 Yorick Laupa+-- License : (see the file LICENSE)+--+-- Maintainer : Yorick Laupa <yo.eight@gmail.com>+-- Stability : provisional+-- Portability : non-portable+--+--------------------------------------------------------------------------------+module EventSource.Store+  ( Batch(..)+  , Subscription(..)+  , SubscriptionId+  , ExpectedVersionException(..)+  , Store(..)+  , SomeStore(..)+  , StreamIterator+  , iteratorNext+  , iteratorNextEvent+  , iteratorReadAll+  , iteratorReadAllEvents+  , streamIterator+  , freshSubscriptionId+  , startFrom+  , nextEventAs+  , foldSub+  , foldSubAsync+  , appendEvent+  , forEvents+  , foldEventsM+  , foldEvents+  ) where++--------------------------------------------------------------------------------+import Prelude (Show(..))++--------------------------------------------------------------------------------+import Control.Monad.Except+import Data.IORef+import Data.UUID+import Data.UUID.V4+import Protolude hiding (from, show, trans)++--------------------------------------------------------------------------------+import EventSource.Types++--------------------------------------------------------------------------------+-- | Represents batch information needed to read a stream.+data Batch =+  Batch { batchFrom :: EventNumber+        , batchSize :: Int32+        }++--------------------------------------------------------------------------------+-- | Starts a 'Batch' from a given point. The batch size is set to default,+--   which is 500.+startFrom :: EventNumber -> Batch+startFrom from = Batch from 500++--------------------------------------------------------------------------------+-- | Represents a subscription id.+newtype SubscriptionId = SubscriptionId UUID deriving (Eq, Ord, Show)++--------------------------------------------------------------------------------+-- | Returns a fresh subscription id.+freshSubscriptionId :: MonadIO m => m SubscriptionId+freshSubscriptionId = liftIO $ fmap SubscriptionId nextRandom++--------------------------------------------------------------------------------+-- | A subscription allows to be notified on every change occuring on a stream.+data Subscription =+  Subscription { subscriptionId :: SubscriptionId++               , nextEvent :: forall m. MonadIO m+                           => m (Either SomeException SavedEvent)+               }++--------------------------------------------------------------------------------+-- | Waits for the next event and deserializes it on the go.+nextEventAs :: (DecodeEvent a, MonadIO m)+            => Subscription+            -> m (Either SomeException a)+nextEventAs sub = do+  res <- nextEvent sub+  let action = do+        event <- res+        first (toException . DecodeEventException)+          $ decodeEvent+          $ savedEvent event++  return action++--------------------------------------------------------------------------------+-- | Folds over every event coming from the subscription until the end of the+--   universe, unless an 'Exception' raises from the subscription.+--   'SomeException' is used because we let the underlying subscription model+--   exposed its own 'Exception'. If the callback that handles incoming events+--   throws an exception, it will not be catch by the error callback.+foldSub :: (DecodeEvent a, MonadIO m)+        => Subscription+        -> (a -> m ())+        -> (SomeException -> m ())+        -> m ()+foldSub sub onEvent onError = loop+  where+    loop = do+      res <- nextEventAs sub+      case res of+        Left e -> onError e+        Right a -> onEvent a >> loop++--------------------------------------------------------------------------------+-- | Asynchronous version of 'foldSub'.+foldSubAsync :: DecodeEvent a+             => Subscription+             -> (a -> IO ())+             -> (SomeException -> IO ())+             -> IO (Async ())+foldSubAsync sub onEvent onError =+  async $ foldSub sub onEvent onError++--------------------------------------------------------------------------------+data ExpectedVersionException+  = ExpectedVersionException+    { versionExceptionExpected :: ExpectedVersion+    , versionExceptionActual :: ExpectedVersion+    } deriving Show++--------------------------------------------------------------------------------+instance Exception ExpectedVersionException++--------------------------------------------------------------------------------+-- | Main event store abstraction. It exposes essential features expected from+--   an event store.+class Store store where+  -- | Appends a batch of events at the end of a stream.+  appendEvents :: (EncodeEvent a, MonadIO m)+               => store+               -> StreamName+               -> ExpectedVersion+               -> [a]+               -> m (Async EventNumber)++  -- | Appends a batch of events at the end of a stream.+  readBatch :: MonadIO m+            => store+            -> StreamName+            -> Batch+            -> m (Async (ReadStatus Slice))++  -- | Subscribes to given stream.+  subscribe :: MonadIO m => store -> StreamName -> m Subscription++--------------------------------------------------------------------------------+-- | Utility type to pass any store that implements 'Store' typeclass.+data SomeStore = forall store. Store store => SomeStore store++--------------------------------------------------------------------------------+instance Store SomeStore where+  appendEvents (SomeStore store) = appendEvents store+  readBatch (SomeStore store)    = readBatch store+  subscribe (SomeStore store)    = subscribe store++--------------------------------------------------------------------------------+-- | Appends a single event at the end of a stream.+appendEvent :: (EncodeEvent a, MonadIO m, Store store)+            => store+            -> StreamName+            -> ExpectedVersion+            -> a+            -> m (Async EventNumber)+appendEvent store stream ver a = appendEvents store stream ver [a]++--------------------------------------------------------------------------------+-- | Represents failures that can occurs when using 'forEvents'.+data ForEventFailure+  = ForEventReadFailure ReadFailure+  | ForEventDecodeFailure Text+  deriving Show++--------------------------------------------------------------------------------+-- | Iterates over all events of stream given a starting point and a batch size.+forEvents :: (MonadIO m, DecodeEvent a, Store store)+          => store+          -> StreamName+          -> (a -> m ())+          -> ExceptT ForEventFailure m ()+forEvents store name k = do+  res <- streamIterator store name+  case res of+    ReadSuccess i -> loop i+    ReadFailure e -> throwError $ ForEventReadFailure e+  where+    loop i = do+      opt <- iteratorNext i+      for_ opt $ \saved ->+        case decodeEvent $ savedEvent saved of+          Left e -> throwError $ ForEventDecodeFailure e+          Right a -> lift (k a) >> loop i++--------------------------------------------------------------------------------+-- | Like 'forEvents' but expose signature similar to 'foldM'.+foldEventsM :: (MonadIO m, DecodeEvent a, Store store)+            => store+            -> StreamName+            -> (s -> a -> m s)+            -> s+            -> ExceptT ForEventFailure m s+foldEventsM store stream k seed = mapExceptT trans action+  where+    trans m = evalStateT m seed++    action = do+      forEvents store stream $ \a -> do+        s <- get+        s' <- lift $ k s a+        put s'+      get++--------------------------------------------------------------------------------+-- | Like 'foldEventsM' but expose signature similar to 'foldl'.+foldEvents :: (MonadIO m, DecodeEvent a, Store store)+           => store+           -> StreamName+           -> (s -> a -> s)+           -> s+           -> ExceptT ForEventFailure m s+foldEvents store stream k seed =+  foldEventsM store stream (\s a -> return $ k s a) seed++--------------------------------------------------------------------------------+-- | Allows to easily iterate over a stream's events.+newtype StreamIterator =+  StreamIterator { iteratorNext :: forall m. MonadIO m => m (Maybe SavedEvent) }++--------------------------------------------------------------------------------+instance Show StreamIterator where+  show _ = "StreamIterator"++--------------------------------------------------------------------------------+-- | Reads the next available event from the 'StreamIterator' and try to+--   deserialize it at the same time.+iteratorNextEvent :: (DecodeEvent a, MonadIO m, MonadPlus m)+                  => StreamIterator+                  -> m (Maybe a)+iteratorNextEvent i = do+  res <- iteratorNext i+  case res of+    Nothing -> return Nothing+    Just s ->+      case decodeEvent $ savedEvent s of+        Left _ -> mzero+        Right a -> return $ Just a++--------------------------------------------------------------------------------+-- | Reads all events from the 'StreamIterator' until reaching end of stream.+iteratorReadAll :: MonadIO m => StreamIterator -> m [SavedEvent]+iteratorReadAll i = do+  res <- iteratorNext i+  case res of+    Nothing -> return []+    Just s -> fmap (s:) $ iteratorReadAll i++--------------------------------------------------------------------------------+-- | Like 'iteratorReadAll' but try to deserialize the events at the same time.+iteratorReadAllEvents :: (DecodeEvent a, MonadIO m, MonadPlus m)+                      => StreamIterator+                      -> m [a]+iteratorReadAllEvents i = do+  res <- iteratorNextEvent i+  case res of+    Nothing -> return []+    Just a -> fmap (a:) $ iteratorReadAllEvents i++--------------------------------------------------------------------------------+-- | Returns a 'StreamIterator' for the given stream name. The returned+--   'StreamIterator' IS NOT THREADSAFE.+streamIterator :: (Store store, MonadIO m)+               => store+               -> StreamName+               -> m (ReadStatus StreamIterator)+streamIterator store name = do+  w <- readBatch store name (startFrom 0)+  res <- liftIO $ wait w+  for res $ \slice -> do+    ref <- liftIO $ newIORef $ IteratorOverAvailable slice+    return $ StreamIterator $ iterateOver store ref name++--------------------------------------------------------------------------------+data IteratorOverState+  = IteratorOverAvailable Slice+  | IteratorOverClosed++--------------------------------------------------------------------------------+data IteratorOverAction+  = IteratorOverEvent SavedEvent+  | IteratorOverNextBatch EventNumber+  | IteratorOverEndOfStream++--------------------------------------------------------------------------------+iterateOver :: (Store store, MonadIO m)+            => store+            -> IORef IteratorOverState+            -> StreamName+            -> m (Maybe SavedEvent)+iterateOver store ref name = go+  where+    go = do+      action <- liftIO $ atomicModifyIORef' ref $ \st ->+        case st of+          IteratorOverAvailable slice ->+            case sliceEvents slice of+              e:es ->+                let nextSlice = slice { sliceEvents = es }+                    nxtSt = IteratorOverAvailable nextSlice in+                (nxtSt, IteratorOverEvent e)+              [] | sliceEndOfStream slice+                   -> (IteratorOverClosed, IteratorOverEndOfStream)+                 | otherwise+                   -> let resp = IteratorOverNextBatch $+                                 sliceNextEventNumber slice in+                     (st, resp)+          IteratorOverClosed -> (st, IteratorOverEndOfStream)++      case action of+        IteratorOverEvent e -> return $ Just e+        IteratorOverEndOfStream -> return Nothing+        IteratorOverNextBatch num -> do+          w <- readBatch store name (startFrom num)+          res <- liftIO $ wait w+          case res of+            ReadFailure _ -> do+              liftIO $ atomicModifyIORef' ref $ \_ -> (IteratorOverClosed, ())+              return Nothing+            ReadSuccess slice -> do+              let nxtSt = IteratorOverAvailable slice+              liftIO $ atomicModifyIORef' ref $ \_ -> (nxtSt, ())+              go

@@ -0,0 +1,320 @@+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE OverloadedStrings          #-}+--------------------------------------------------------------------------------+-- |+-- Module : EventSource.Types+-- Copyright : (C) 2016 Yorick Laupa+-- License : (see the file LICENSE)+--+-- Maintainer : Yorick Laupa <yo.eight@gmail.com>+-- Stability : provisional+-- Portability : non-portable+--+--------------------------------------------------------------------------------+module EventSource.Types where++--------------------------------------------------------------------------------+import Prelude (Show(..))+import Data.Foldable+import Data.String++--------------------------------------------------------------------------------+import Protolude hiding (show)+import Data.Aeson+import Data.Aeson.Types+import Data.UUID hiding (fromString)+import Data.UUID.V4+import qualified Data.HashMap.Strict as H+import qualified Data.Map.Strict as M++--------------------------------------------------------------------------------+-- | Opaque data type used to store raw data.+data Data+  = Data ByteString+  | DataAsJson Value++--------------------------------------------------------------------------------+instance Show Data where+  show _ = "Data(*Binary data*)"++--------------------------------------------------------------------------------+-- | Sometimes, having to implement a 'FromJSON' instance isn't flexible enough.+--   'JsonParsing' allow to pass parameters when parsing from a JSON value while+--   remaining composable.+newtype JsonParsing a = JsonParsing (Value -> Parser a)++--------------------------------------------------------------------------------+instance Functor JsonParsing where+  fmap f (JsonParsing k) = JsonParsing $ \v -> f <$> k v++--------------------------------------------------------------------------------+instance Applicative JsonParsing where+  pure a = JsonParsing $ \_ -> return a++  (JsonParsing kf) <*> (JsonParsing ka) =+    JsonParsing $ \v ->+      kf v <*> ka v++--------------------------------------------------------------------------------+instance Monad JsonParsing where+  return = pure++  JsonParsing k >>= f = JsonParsing $ \v -> do+    a <- k v+    let JsonParsing km = f a+    km v++--------------------------------------------------------------------------------+-- | Returns 'Data' content as a 'ByteString'.+dataAsBytes :: Data -> ByteString+dataAsBytes (Data bs) = bs+dataAsBytes (DataAsJson v) = toS $ encode v++--------------------------------------------------------------------------------+-- | Creates a 'Data' object from a raw 'ByteString'.+dataFromBytes :: ByteString -> Data+dataFromBytes = Data++--------------------------------------------------------------------------------+-- | Creates a 'Data' object from a JSON object.+dataFromJson :: ToJSON a => a -> Data+dataFromJson = DataAsJson . toJSON++--------------------------------------------------------------------------------+-- | Returns 'Data' content as any value that implements 'FromJSON' type-class.+dataAsJson :: FromJSON a => Data -> Either Text a+dataAsJson (Data bs) = first toS $ eitherDecodeStrict bs+dataAsJson (DataAsJson v) = first toS $ parseEither parseJSON v++--------------------------------------------------------------------------------+-- | Uses a 'JsonParsing' comuputation to extract a value.+dataAsParsing :: Data -> JsonParsing a -> Either Text a+dataAsParsing dat (JsonParsing k) = do+  value <- dataAsJson dat+  first toS $ parseEither k value++--------------------------------------------------------------------------------+-- | Like 'dataAsParsing' but doesn't require you to use 'JsonParsing'.+dataAsParse :: Data -> (Value -> Parser a) -> Either Text a+dataAsParse dat k = dataAsParsing dat $ JsonParsing k++--------------------------------------------------------------------------------+-- | Used to store a set a properties. One example is to be used as 'Event'+--   metadata.+newtype Properties = Properties (Map Text Text)++--------------------------------------------------------------------------------+instance Monoid Properties where+  mempty = Properties mempty+  mappend (Properties a) (Properties b) = Properties $ mappend a b++--------------------------------------------------------------------------------+instance Show Properties where+  show (Properties m) = show m++--------------------------------------------------------------------------------+instance ToJSON Properties where+  toJSON = object . fmap go . properties+    where+      go (k, v) = k .= v++--------------------------------------------------------------------------------+instance FromJSON Properties where+  parseJSON = withObject "Properties" $ \o ->+    let go p k = fmap (\v -> setProperty k v p) (o .: k) in+    foldlM go mempty (H.keys o)++--------------------------------------------------------------------------------+-- | Retrieves a value associated with the given key.+property :: MonadPlus m => Text -> Properties -> m Text+property k (Properties m) =+  case M.lookup k m of+    Nothing -> mzero+    Just v -> return v++--------------------------------------------------------------------------------+-- | Builds a 'Properties' with a single pair of key-value.+singleton :: Text -> Text -> Properties+singleton k v = setProperty k v mempty++--------------------------------------------------------------------------------+-- | Adds a pair of key-value into given 'Properties'.+setProperty :: Text -> Text -> Properties -> Properties+setProperty key value (Properties m) = Properties $ M.insert key value m++--------------------------------------------------------------------------------+-- | Returns all associated key-value pairs as a list.+properties :: Properties -> [(Text, Text)]+properties (Properties m) = M.toList m++--------------------------------------------------------------------------------+-- | Used to identify an event.+newtype EventId = EventId UUID deriving (Eq, Ord)++--------------------------------------------------------------------------------+instance Show EventId where+  show (EventId uuid) = show uuid++--------------------------------------------------------------------------------+-- | Generates a fresh 'EventId'.+freshEventId :: MonadIO m => m EventId+freshEventId = fmap EventId $ liftIO nextRandom++--------------------------------------------------------------------------------+-- | Represents a stream name.+newtype StreamName = StreamName Text deriving (Eq, Ord)++--------------------------------------------------------------------------------+instance Show StreamName where+  show (StreamName s) = show s++--------------------------------------------------------------------------------+instance IsString StreamName where+  fromString = StreamName . fromString++--------------------------------------------------------------------------------+-- | Used to identity the type of an 'Event'.+newtype EventType = EventType Text deriving Eq++--------------------------------------------------------------------------------+instance Show EventType where+  show (EventType t) = show t++--------------------------------------------------------------------------------+instance IsString EventType where+  fromString = EventType . fromString++--------------------------------------------------------------------------------+-- | Sets 'EventType' for an 'Event'.+setEventType :: EventType -> State Event ()+setEventType typ = modify $ \s -> s { eventType = typ }++--------------------------------------------------------------------------------+-- | Sets 'Eventid' for an 'Event'.+setEventId :: EventId -> State Event ()+setEventId eid = modify $ \s -> s { eventId = eid }++--------------------------------------------------------------------------------+-- | Sets a payload for an 'Event'.+setEventPayload :: Data -> State Event ()+setEventPayload dat = modify $ \s -> s { eventPayload = dat }++--------------------------------------------------------------------------------+-- | Sets metadata for an 'Event'.+setEventMetadata :: Properties -> State Event ()+setEventMetadata props = modify $ \s -> s { eventMetadata = Just props }++--------------------------------------------------------------------------------+-- | Encapsulates an event which is about to be saved.+data Event =+  Event { eventType :: EventType+        , eventId :: EventId+        , eventPayload :: Data+        , eventMetadata :: Maybe Properties+        } deriving Show++--------------------------------------------------------------------------------+-- | Represents an event index in a stream.+newtype EventNumber = EventNumber Int32 deriving (Eq, Ord, Num, Enum, Show)++--------------------------------------------------------------------------------+-- | Represents an event that's saved into the event store.+data SavedEvent =+  SavedEvent { eventNumber :: EventNumber+             , savedEvent :: Event+             } deriving Show++--------------------------------------------------------------------------------+-- | Deserializes a 'SavedEvent'.+savedEventAs :: DecodeEvent a => SavedEvent -> Either Text a+savedEventAs = decodeEvent . savedEvent++--------------------------------------------------------------------------------+-- | Represents batch of events read from a store.+data Slice =+  Slice { sliceEvents :: [SavedEvent]+        , sliceEndOfStream :: Bool+        , sliceNextEventNumber :: EventNumber+        } deriving Show++--------------------------------------------------------------------------------+-- | Deserializes a 'Slice''s events.+sliceEventsAs :: DecodeEvent a => Slice -> Either Text [a]+sliceEventsAs = traverse savedEventAs . sliceEvents++--------------------------------------------------------------------------------+-- | Encodes a data object into an 'Event'. 'encodeEvent' get passed an+--   'EventId' in a case where a fresh id is needed.+class EncodeEvent a where+  encodeEvent :: a -> State Event ()++--------------------------------------------------------------------------------+-- | Decodes an 'Event' into a data object.+class DecodeEvent a where+  decodeEvent :: Event -> Either Text a++--------------------------------------------------------------------------------+newtype DecodeEventException = DecodeEventException Text deriving Show++--------------------------------------------------------------------------------+instance Exception DecodeEventException++--------------------------------------------------------------------------------+instance DecodeEvent Event where+  decodeEvent = Right++--------------------------------------------------------------------------------+-- | The purpose of 'ExpectedVersion' is to make sure a certain stream state is+--   at an expected point in order to carry out a write.+data ExpectedVersion+  = AnyVersion+    -- Stream is a any given state.+  | NoStream+    -- Stream shouldn't exist.+  | StreamExists+    -- Stream should exist.+  | ExactVersion EventNumber+    -- Stream should be at givent event number.+  deriving Show++--------------------------------------------------------------------------------+-- | Statuses you can get on every read attempt.+data ReadStatus a+  = ReadSuccess a+  | ReadFailure ReadFailure+  deriving Show++--------------------------------------------------------------------------------+-- | Returns 'True' is 'ReadStatus' is a 'ReadSuccess'.+isReadSuccess :: ReadStatus a -> Bool+isReadSuccess (ReadSuccess _) = True+isReadSuccess _ = False++--------------------------------------------------------------------------------+-- | Returns 'False' is 'ReadStatus' is a 'ReadFailure'.+isReadFailure :: ReadStatus a -> Bool+isReadFailure (ReadFailure _) = True+isReadFailure _ = False++--------------------------------------------------------------------------------+-- | Represents the different kind of failure you can get when reading.+data ReadFailure+  = StreamNotFound+  | ReadError (Maybe Text)+  | AccessDenied+  deriving Show++--------------------------------------------------------------------------------+instance Functor ReadStatus where+  fmap f (ReadSuccess a)  = ReadSuccess $ f a+  fmap _ (ReadFailure e)  = ReadFailure e++--------------------------------------------------------------------------------+instance Foldable ReadStatus where+  foldMap f (ReadSuccess a) = f a+  foldMap _ _               = mempty++--------------------------------------------------------------------------------+instance Traversable ReadStatus where+  traverse f (ReadSuccess a) = fmap ReadSuccess $ f a+  traverse _ (ReadFailure e) = pure $ ReadFailure e

@@ -0,0 +1,32 @@+# 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: Please read README.md.+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+    - uuid+    - aeson+    - mtl+    - containers+    - unordered-containers+  source-dirs: library+license: BSD3+license-file: LICENSE.md+author: Yorick Laupa+maintainer: yo.eight@gmail.com+name: eventsource-api+synopsis: Provides a eventsourcing high level API.+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.3"+#+# 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