eventstore 1.0.0 → 1.1.0

raw patch · 45 files changed

+602/−567 lines, 45 filesdep ~dnsPVP ok

version bump matches the API change (PVP)

Dependency ranges changed: dns

API changes (from Hackage documentation)

Files

• .gitignore +0/−14
• .travis.yml +0/−180
• CHANGELOG.markdown +6/−0
• Database/EventStore.hs +81/−54
• Database/EventStore/Internal/ConnectionManager.hs +130/−36
• Database/EventStore/Internal/Manager/Operation/Registry.hs +8/−7
• Database/EventStore/Internal/Operation.hs +8/−5
• Database/EventStore/Internal/Operation/Authenticate.hs +29/−0
• Database/EventStore/Internal/Operation/Catchup.hs +16/−9
• Database/EventStore/Internal/Operation/DeleteStream.hs +4/−3
• Database/EventStore/Internal/Operation/DeleteStream/Message.hs +2/−2
• Database/EventStore/Internal/Operation/Identify.hs +52/−0
• Database/EventStore/Internal/Operation/Persist.hs +7/−5
• Database/EventStore/Internal/Operation/PersistOperations.hs +14/−7
• Database/EventStore/Internal/Operation/Read/Common.hs +5/−5
• Database/EventStore/Internal/Operation/ReadAllEvents.hs +3/−2
• Database/EventStore/Internal/Operation/ReadEvent.hs +3/−2
• Database/EventStore/Internal/Operation/ReadStreamEvents.hs +4/−3
• Database/EventStore/Internal/Operation/ReadStreamEvents/Message.hs +4/−4
• Database/EventStore/Internal/Operation/StreamMetadata.hs +9/−5
• Database/EventStore/Internal/Operation/Transaction.hs +14/−8
• Database/EventStore/Internal/Operation/Transaction/Message.hs +4/−4
• Database/EventStore/Internal/Operation/Volatile.hs +6/−5
• Database/EventStore/Internal/Operation/Write/Common.hs +1/−1
• Database/EventStore/Internal/Operation/WriteEvents.hs +4/−3
• Database/EventStore/Internal/Operation/WriteEvents/Message.hs +4/−4
• Database/EventStore/Internal/Prelude.hs +8/−0
• Database/EventStore/Internal/Settings.hs +33/−28
• Database/EventStore/Internal/Subscription/Catchup.hs +6/−5
• Database/EventStore/Internal/Subscription/Command.hs +3/−3
• Database/EventStore/Internal/Subscription/Message.hs +4/−4
• Database/EventStore/Internal/Subscription/Packages.hs +16/−71
• Database/EventStore/Internal/Subscription/Persistent.hs +9/−9
• Database/EventStore/Internal/Subscription/Regular.hs +3/−2
• Database/EventStore/Internal/Subscription/Types.hs +1/−1
• Database/EventStore/Internal/Test.hs +1/−0
• Database/EventStore/Internal/Types.hs +12/−12
• LICENSE +1/−1
• README.md +8/−4
• eventstore-test-setup-osx.sh +0/−5
• eventstore-test-setup.sh +0/−5
• eventstore.cabal +6/−8
• tests/Test/Bogus/Connection.hs +33/−1
• tests/Test/Integration/Tests.hs +39/−39
• tests/Test/Operation.hs +1/−1

@@ -1,14 +0,0 @@-dist-cabal-dev-*.o-*.hi-*.chi-*.chs.h-.virtualenv-.hsenv-.cabal-sandbox/-cabal.sandbox.config-cabal.config-*~-*.swp-.stack-work/

@@ -1,180 +0,0 @@-# This is the complex Travis configuration, which is intended for use-# on open source libraries which need compatibility across multiple GHC-# versions, must work with cabal-install, and should be-# cross-platform. For more information and other options, see:-#-# https://docs.haskellstack.org/en/stable/travis_ci/-#-# Copy these contents into the root directory of your Github project in a file-# named .travis.yml--# Use new container infrastructure to enable caching-sudo: false--# Do not choose a language; we provide our own build tools.-language: generic--# Caching so the next build will be fast too.-cache:-  directories:-  - $HOME/.ghc-  - $HOME/.cabal-  - $HOME/.stack--# The different configurations we want to test. We have BUILD=cabal which uses-# cabal-install, and BUILD=stack which uses Stack. More documentation on each-# of those below.-#-# We set the compiler values here to tell Travis to use a different-# cache file per set of arguments.-#-# If you need to have different apt packages for each combination in the-# matrix, you can use a line such as:-#     addons: {apt: {packages: [libfcgi-dev,libgmp-dev]}}-matrix:-  include:-  # We grab the appropriate GHC and cabal-install versions from hvr's PPA. See:-  # https://github.com/hvr/multi-ghc-travis-  - env: BUILD=cabal GHCVER=7.8.4 CABALVER=head HAPPYVER=1.19.5 ALEXVER=3.1.7-    compiler: ": #GHC 7.8.4"-    addons: {apt: {packages: [cabal-install-head,ghc-7.8.4,happy-1.19.5,alex-3.1.7], sources: [hvr-ghc]}}-  - env: BUILD=cabal GHCVER=7.10.3 CABALVER=head HAPPYVER=1.19.5 ALEXVER=3.1.7-    compiler: ": #GHC 7.10.3"-    addons: {apt: {packages: [cabal-install-head,ghc-7.10.3,happy-1.19.5,alex-3.1.7], sources: [hvr-ghc]}}-  - env: BUILD=cabal GHCVER=8.0.2 CABALVER=head HAPPYVER=1.19.5 ALEXVER=3.1.7-    compiler: ": #GHC 8.0.2"-    addons: {apt: {packages: [cabal-install-head,ghc-8.0.2,happy-1.19.5,alex-3.1.7], sources: [hvr-ghc]}}-  - env: BUILD=cabal GHCVER=8.2.1 CABALVER=head HAPPYVER=1.19.5 ALEXVER=3.1.7-    compiler: ": #GHC 8.2.1"-    addons: {apt: {packages: [cabal-install-head,ghc-8.2.1,happy-1.19.5,alex-3.1.7], sources: [hvr-ghc]}}---  # Build with the newest GHC and cabal-install. This is an accepted failure,-  # see below.-  - env: BUILD=cabal GHCVER=head  CABALVER=head HAPPYVER=1.19.5 ALEXVER=3.1.7-    compiler: ": #GHC HEAD"-    addons: {apt: {packages: [cabal-install-head,ghc-head,happy-1.19.5,alex-3.1.7], sources: [hvr-ghc]}}--  # The Stack builds. We can pass in arbitrary Stack arguments via the ARGS-  # variable, such as using --stack-yaml to point to a different file.-  - env: BUILD=stack ARGS=""-    compiler: ": #stack default"-    addons: {apt: {packages: [libgmp-dev]}}--  - env: BUILD=stack ARGS="--compiler ghc-8.0.2 --resolver lts-9"-    compiler: ": #stack 8.0.2 lts-9"-    addons: {apt: {packages: [libgmp-dev]}}--  # Nightly builds are allowed to fail-  - env: BUILD=stack ARGS="--resolver nightly"-    compiler: ": #stack nightly"-    addons: {apt: {packages: [libgmp-dev]}}--  # Build on OS X in addition to Linux-  - env: BUILD=stack ARGS=""-    compiler: ": #stack default osx"-    os: osx--  # Travis includes an OS X which is incompatible with GHC 7.8.4--  - env: BUILD=stack ARGS="--resolver lts-9 --compiler ghc-8.0.2"-    compiler: ": #stack 8.0.2 osx lts-9"-    os: osx--  - env: BUILD=stack ARGS="--resolver nightly"-    compiler: ": #stack nightly osx"-    os: osx--  allow_failures:-  - env: BUILD=cabal GHCVER=head  CABALVER=head HAPPYVER=1.19.5 ALEXVER=3.1.7-  - env: BUILD=stack ARGS="--resolver nightly"--before_install:-# Using compiler above sets CC to an invalid value, so unset it-- unset CC--# Setting up GetEventStore database.-- |-  if [ `uname` = "Darwin" ]-  then-    bash eventstore-test-setup-osx.sh-  else-    bash eventstore-test-setup.sh-  fi--# We want to always allow newer versions of packages when building on GHC HEAD-- CABALARGS=""-- if [ "x$GHCVER" = "xhead" ]; then CABALARGS=--allow-newer; fi--# Download and unpack the stack executable-- export PATH=/opt/ghc/$GHCVER/bin:/opt/cabal/$CABALVER/bin:$HOME/.local/bin:/opt/alex/$ALEXVER/bin:/opt/happy/$HAPPYVER/bin:$HOME/.cabal/bin:$PATH-- mkdir -p ~/.local/bin-- |-  if [ `uname` = "Darwin" ]-  then-    travis_retry curl --insecure -L https://www.stackage.org/stack/osx-x86_64 | tar xz --strip-components=1 --include '*/stack' -C ~/.local/bin-  else-    travis_retry curl -L https://www.stackage.org/stack/linux-x86_64 | tar xz --wildcards --strip-components=1 -C ~/.local/bin '*/stack'-  fi--  # Use the more reliable S3 mirror of Hackage-  mkdir -p $HOME/.cabal-  echo 'remote-repo: hackage.haskell.org:http://hackage.fpcomplete.com/' > $HOME/.cabal/config-  echo 'remote-repo-cache: $HOME/.cabal/packages' >> $HOME/.cabal/config--  if [ "$CABALVER" != "1.16" ]-  then-    echo 'jobs: $ncpus' >> $HOME/.cabal/config-  fi--install:-- echo "$(ghc --version) [$(ghc --print-project-git-commit-id 2> /dev/null || echo '?')]"-- if [ -f configure.ac ]; then autoreconf -i; fi-- |-  set -ex-  case "$BUILD" in-    stack)-      stack --no-terminal --install-ghc $ARGS test --bench --only-dependencies-      ;;-    cabal)-      cabal --version-      travis_retry cabal update--      # Get the list of packages from the stack.yaml file-      PACKAGES=$(stack --install-ghc query locals | grep '^ *path' | sed 's@^ *path:@@')--      cabal install --only-dependencies --enable-tests --enable-benchmarks --force-reinstalls --ghc-options=-O0 --reorder-goals --max-backjumps=-1 $CABALARGS $PACKAGES-      ;;-  esac-  set +ex--script:-- |-  set -ex-  case "$BUILD" in-    stack)-      stack --no-terminal $ARGS test --bench --no-run-benchmarks --haddock --no-haddock-deps-      ;;-    cabal)-      cabal install --enable-tests --enable-benchmarks --force-reinstalls --ghc-options=-O0 --reorder-goals --max-backjumps=-1 $CABALARGS $PACKAGES--      ORIGDIR=$(pwd)-      for dir in $PACKAGES-      do-        cd $dir-        cabal check || [ "$CABALVER" == "1.16" ]-        cabal sdist-        PKGVER=$(cabal info . | awk '{print $2;exit}')-        SRC_TGZ=$PKGVER.tar.gz-        cd dist-        tar zxfv "$SRC_TGZ"-        cd "$PKGVER"-        cabal configure --enable-tests-        cabal build-        cd $ORIGDIR-      done-      ;;-  esac-  set +ex--# EOF

@@ -1,3 +1,9 @@+1.1.0+-----+* Supports GetEventStore >= 4.0.0 protocol changes.+* No longer support GetEventStore < 4.0.0.+* Stream versions are `Int64`.+ 1.0.0 ----- * Support SemVer versioning.

@@ -297,36 +297,39 @@ -------------------------------------------------------------------------------- -- | Sends a single 'Event' to given stream. sendEvent :: Connection-          -> StreamName              -- ^ Stream name+          -> StreamName           -> ExpectedVersion           -> Event+          -> Maybe Credentials           -> IO (Async WriteResult)-sendEvent mgr evt_stream exp_ver evt =-    sendEvents mgr evt_stream exp_ver [evt]+sendEvent mgr evt_stream exp_ver evt cred =+    sendEvents mgr evt_stream exp_ver [evt] cred  -------------------------------------------------------------------------------- -- | Sends a list of 'Event' to given stream. sendEvents :: Connection-           -> StreamName             -- ^ Stream name+           -> StreamName            -> ExpectedVersion            -> [Event]+           -> Maybe Credentials            -> IO (Async WriteResult)-sendEvents Connection{..} evt_stream exp_ver evts = do+sendEvents Connection{..} evt_stream exp_ver evts cred = do     p <- newPromise-    let op = Op.writeEvents _settings (streamNameRaw evt_stream) exp_ver evts+    let op = Op.writeEvents _settings (streamNameRaw evt_stream) exp_ver cred evts     publishWith _exec (SubmitOperation p op)     async (retrieve p)  -------------------------------------------------------------------------------- -- | Deletes given stream. deleteStream :: Connection-             -> StreamName             -- ^ Stream name+             -> StreamName              -> ExpectedVersion              -> Maybe Bool       -- ^ Hard delete+             -> Maybe Credentials              -> IO (Async Op.DeleteResult)-deleteStream Connection{..} evt_stream exp_ver hard_del = do+deleteStream Connection{..} evt_stream exp_ver hard_del cred = do     p <- newPromise-    let op = Op.deleteStream _settings (streamNameRaw evt_stream) exp_ver hard_del+    let op = Op.deleteStream _settings (streamNameRaw evt_stream) exp_ver hard_del cred     publishWith _exec (SubmitOperation p op)     async (retrieve p) @@ -356,10 +359,11 @@ startTransaction :: Connection                  -> StreamName            -- ^ Stream name                  -> ExpectedVersion+                 -> Maybe Credentials                  -> IO (Async Transaction)-startTransaction conn@Connection{..} evt_stream exp_ver = do+startTransaction conn@Connection{..} evt_stream exp_ver cred = do     p <- newPromise-    let op = Op.transactionStart _settings (streamNameRaw evt_stream) exp_ver+    let op = Op.transactionStart _settings (streamNameRaw evt_stream) exp_ver cred     publishWith _exec (SubmitOperation p op)     async $ do         tid <- retrieve p@@ -372,23 +376,26 @@  -------------------------------------------------------------------------------- -- | Asynchronously writes to a transaction in the EventStore.-transactionWrite :: Transaction -> [Event] -> IO (Async ())-transactionWrite Transaction{..} evts = do+transactionWrite :: Transaction+                 -> [Event]+                 -> Maybe Credentials+                 -> IO (Async ())+transactionWrite Transaction{..} evts cred = do     p <- newPromise     let Connection{..} = _tConn         raw_id = _unTransId _tTransId-        op     = Op.transactionWrite _settings _tStream _tExpVer raw_id evts+        op     = Op.transactionWrite _settings _tStream _tExpVer raw_id evts cred     publishWith _exec (SubmitOperation p op)     async (retrieve p)  -------------------------------------------------------------------------------- -- | Asynchronously commits this transaction.-transactionCommit :: Transaction -> IO (Async WriteResult)-transactionCommit Transaction{..} = do+transactionCommit :: Transaction -> Maybe Credentials -> IO (Async WriteResult)+transactionCommit Transaction{..} cred = do     p <- newPromise     let Connection{..} = _tConn         raw_id = _unTransId _tTransId-        op     = Op.transactionCommit _settings _tStream _tExpVer raw_id+        op     = Op.transactionCommit _settings _tStream _tExpVer raw_id cred     publishWith _exec (SubmitOperation p op)     async (retrieve p) @@ -401,23 +408,25 @@ -------------------------------------------------------------------------------- -- | Reads a single event from given stream. readEvent :: Connection-          -> StreamName       -- ^ Stream name+          -> StreamName           -> Int32      -- ^ Event number           -> Bool       -- ^ Resolve Link Tos+          -> Maybe Credentials           -> IO (Async (ReadResult 'RegularStream Op.ReadEvent))-readEvent Connection{..} stream_id evt_num res_link_tos = do+readEvent Connection{..} stream_id evt_num res_link_tos cred = do     p <- newPromise-    let op = Op.readEvent _settings (streamNameRaw stream_id) evt_num res_link_tos+    let op = Op.readEvent _settings (streamNameRaw stream_id) evt_num res_link_tos cred     publishWith _exec (SubmitOperation p op)     async (retrieve p)  -------------------------------------------------------------------------------- -- | Reads events from a given stream forward. readStreamEventsForward :: Connection-                        -> StreamName       -- ^ Stream name-                        -> Int32      -- ^ From event number+                        -> StreamName+                        -> Int64      -- ^ From event number                         -> Int32      -- ^ Batch size                         -> Bool       -- ^ Resolve Link Tos+                        -> Maybe Credentials                         -> IO (Async (ReadResult 'RegularStream StreamSlice)) readStreamEventsForward mgr =     readStreamEventsCommon mgr Forward@@ -425,10 +434,11 @@ -------------------------------------------------------------------------------- -- | Reads events from a given stream backward. readStreamEventsBackward :: Connection-                         -> StreamName       -- ^ Stream name-                         -> Int32      -- ^ From event number+                         -> StreamName+                         -> Int64      -- ^ From event number                          -> Int32      -- ^ Batch size                          -> Bool       -- ^ Resolve Link Tos+                         -> Maybe Credentials                          -> IO (Async (ReadResult 'RegularStream StreamSlice)) readStreamEventsBackward mgr =     readStreamEventsCommon mgr Backward@@ -437,14 +447,15 @@ readStreamEventsCommon :: Connection                        -> ReadDirection                        -> StreamName-                       -> Int32+                       -> Int64                        -> Int32                        -> Bool+                       -> Maybe Credentials                        -> IO (Async (ReadResult 'RegularStream StreamSlice))-readStreamEventsCommon Connection{..} dir stream_id start cnt res_link_tos = do+readStreamEventsCommon Connection{..} dir stream_id start cnt res_link_tos cred = do     p <- newPromise     let name = streamNameRaw stream_id-        op   = Op.readStreamEvents _settings dir name start cnt res_link_tos+        op   = Op.readStreamEvents _settings dir name start cnt res_link_tos cred     publishWith _exec (SubmitOperation p op)     async (retrieve p) @@ -454,6 +465,7 @@                      -> Position                      -> Int32      -- ^ Batch size                      -> Bool       -- ^ Resolve Link Tos+                     -> Maybe Credentials                      -> IO (Async AllSlice) readAllEventsForward mgr =     readAllEventsCommon mgr Forward@@ -464,6 +476,7 @@                       -> Position                       -> Int32      -- ^ Batch size                       -> Bool       -- ^ Resolve Link Tos+                      -> Maybe Credentials                       -> IO (Async AllSlice) readAllEventsBackward mgr =     readAllEventsCommon mgr Backward@@ -474,10 +487,11 @@                     -> Position                     -> Int32                     -> Bool+                    -> Maybe Credentials                     -> IO (Async AllSlice)-readAllEventsCommon Connection{..} dir pos max_c res_link_tos = do+readAllEventsCommon Connection{..} dir pos max_c res_link_tos cred = do     p <- newPromise-    let op = Op.readAllEvents _settings c_pos p_pos max_c res_link_tos dir+    let op = Op.readAllEvents _settings c_pos p_pos max_c res_link_tos dir cred     publishWith _exec (SubmitOperation p op)     async (retrieve p)   where@@ -486,18 +500,20 @@ -------------------------------------------------------------------------------- -- | Subcribes to given stream. subscribe :: Connection-          -> StreamName       -- ^ Stream name+          -> StreamName           -> Bool       -- ^ Resolve Link Tos+          -> Maybe Credentials           -> IO RegularSubscription-subscribe Connection{..} stream resLnkTos =-    newRegularSubscription _exec stream resLnkTos+subscribe Connection{..} stream resLnkTos cred =+    newRegularSubscription _exec stream resLnkTos cred  -------------------------------------------------------------------------------- -- | Subcribes to $all stream. subscribeToAll :: Connection                -> Bool       -- ^ Resolve Link Tos+               -> Maybe Credentials                -> IO RegularSubscription-subscribeToAll conn = subscribe conn AllStream+subscribeToAll conn resLnkTos cred = subscribe conn AllStream resLnkTos cred  -------------------------------------------------------------------------------- -- | Subscribes to given stream. If last checkpoint is defined, this will@@ -505,13 +521,14 @@ --   beginning. Once last stream event reached up, a subscription request will --   be sent using 'subscribe'. subscribeFrom :: Connection-              -> StreamName        -- ^ Stream name+              -> StreamName               -> Bool        -- ^ Resolve Link Tos-              -> Maybe Int32 -- ^ Last checkpoint+              -> Maybe Int64 -- ^ Last checkpoint               -> Maybe Int32 -- ^ Batch size+              -> Maybe Credentials               -> IO CatchupSubscription-subscribeFrom conn streamId resLnkTos lastChkPt batch =-    subscribeFromCommon conn resLnkTos batch tpe+subscribeFrom conn streamId resLnkTos lastChkPt batch cred =+    subscribeFromCommon conn resLnkTos batch cred tpe   where     tpe = Op.RegularCatchup (streamNameRaw streamId) (fromMaybe 0 lastChkPt) @@ -521,9 +538,10 @@                    -> Bool           -- ^ Resolve Link Tos                    -> Maybe Position -- ^ Last checkpoint                    -> Maybe Int32    -- ^ Batch size+                   -> Maybe Credentials                    -> IO CatchupSubscription-subscribeToAllFrom conn resLnkTos lastChkPt batch =-    subscribeFromCommon conn resLnkTos batch tpe+subscribeToAllFrom conn resLnkTos lastChkPt batch cred =+    subscribeFromCommon conn resLnkTos batch cred tpe   where     Position cPos pPos = fromMaybe positionStart lastChkPt     tpe = Op.AllCatchup (Position cPos pPos)@@ -532,10 +550,11 @@ subscribeFromCommon :: Connection                     -> Bool                     -> Maybe Int32+                    -> Maybe Credentials                     -> Op.CatchupState                     -> IO CatchupSubscription-subscribeFromCommon Connection{..} resLnkTos batch tpe =-    newCatchupSubscription _exec resLnkTos batch tpe+subscribeFromCommon Connection{..} resLnkTos batch cred tpe =+    newCatchupSubscription _exec resLnkTos batch cred tpe  -------------------------------------------------------------------------------- -- | Asynchronously sets the metadata for a stream.@@ -543,20 +562,24 @@                   -> StreamName                   -> ExpectedVersion                   -> StreamMetadata+                  -> Maybe Credentials                   -> IO (Async WriteResult)-setStreamMetadata Connection{..} evt_stream exp_ver metadata = do+setStreamMetadata Connection{..} evt_stream exp_ver metadata cred = do     p <- newPromise     let name = streamNameRaw evt_stream-        op = Op.setMetaStream _settings name exp_ver metadata+        op = Op.setMetaStream _settings name exp_ver cred metadata     publishWith _exec (SubmitOperation p op)     async (retrieve p)  -------------------------------------------------------------------------------- -- | Asynchronously gets the metadata of a stream.-getStreamMetadata :: Connection -> StreamName -> IO (Async StreamMetadataResult)-getStreamMetadata Connection{..} evt_stream = do+getStreamMetadata :: Connection+                  -> StreamName+                  -> Maybe Credentials+                  -> IO (Async StreamMetadataResult)+getStreamMetadata Connection{..} evt_stream cred = do     p <- newPromise-    let op = Op.readMetaStream _settings (streamNameRaw evt_stream)+    let op = Op.readMetaStream _settings (streamNameRaw evt_stream) cred     publishWith _exec (SubmitOperation p op)     async (retrieve p) @@ -566,10 +589,11 @@                              -> Text                              -> StreamName                              -> PersistentSubscriptionSettings+                             -> Maybe Credentials                              -> IO (Async (Maybe PersistActionException))-createPersistentSubscription Connection{..} grp stream sett = do+createPersistentSubscription Connection{..} grp stream sett cred = do     p <- newPromise-    let op = Op.createPersist grp (streamNameRaw stream) sett+    let op = Op.createPersist grp (streamNameRaw stream) sett cred     publishWith _exec (SubmitOperation p op)     async (persistAsync p) @@ -579,10 +603,11 @@                              -> Text                              -> StreamName                              -> PersistentSubscriptionSettings+                             -> Maybe Credentials                              -> IO (Async (Maybe PersistActionException))-updatePersistentSubscription Connection{..} grp stream sett = do+updatePersistentSubscription Connection{..} grp stream sett cred = do     p <- newPromise-    let op = Op.updatePersist grp (streamNameRaw stream) sett+    let op = Op.updatePersist grp (streamNameRaw stream) sett cred     publishWith _exec (SubmitOperation p op)     async (persistAsync p) @@ -591,10 +616,11 @@ deletePersistentSubscription :: Connection                              -> Text                              -> StreamName+                             -> Maybe Credentials                              -> IO (Async (Maybe PersistActionException))-deletePersistentSubscription Connection{..} grp stream = do+deletePersistentSubscription Connection{..} grp stream cred = do     p <- newPromise-    let op = Op.deletePersist grp (streamNameRaw stream)+    let op = Op.deletePersist grp (streamNameRaw stream) cred     publishWith _exec (SubmitOperation p op)     async (persistAsync p) @@ -605,9 +631,10 @@                                 -> Text                                 -> StreamName                                 -> Int32+                                -> Maybe Credentials                                 -> IO PersistentSubscription-connectToPersistentSubscription Connection{..} group stream bufSize =-    newPersistentSubscription _exec group stream bufSize+connectToPersistentSubscription Connection{..} group stream bufSize cred =+    newPersistentSubscription _exec group stream bufSize cred  -------------------------------------------------------------------------------- persistAsync :: Callback (Maybe PersistActionException)

@@ -2,6 +2,7 @@ {-# LANGUAGE OverloadedStrings  #-} {-# LANGUAGE LambdaCase         #-} {-# LANGUAGE RecordWildCards    #-}+{-# LANGUAGE ViewPatterns       #-} -------------------------------------------------------------------------------- -- | -- Module : Database.EventStore.Internal.ConnectionManager@@ -33,6 +34,8 @@ import           Database.EventStore.Internal.EndPoint import           Database.EventStore.Internal.Logger import           Database.EventStore.Internal.Operation+import           Database.EventStore.Internal.Operation.Authenticate (newAuthenticatePkg)+import           Database.EventStore.Internal.Operation.Identify (newIdentifyPkg) import qualified Database.EventStore.Internal.OperationManager as Operation import           Database.EventStore.Internal.Prelude import           Database.EventStore.Internal.Stopwatch@@ -57,6 +60,8 @@   = Reconnecting   | EndpointDiscovery   | ConnectionEstablishing Connection+  | Authentication UUID NominalDiffTime Connection+  | Identification UUID NominalDiffTime Connection   deriving Show  --------------------------------------------------------------------------------@@ -81,6 +86,16 @@ instance Exception ConnectionMaxAttemptReached  --------------------------------------------------------------------------------+data IdentificationTimeout = IdentificationTimeout deriving Typeable++--------------------------------------------------------------------------------+instance Show IdentificationTimeout where+  show _ = "Timed out waiting for client to be identified."++--------------------------------------------------------------------------------+instance Exception IdentificationTimeout++-------------------------------------------------------------------------------- data EstablishConnection = EstablishConnection EndPoint deriving Typeable  --------------------------------------------------------------------------------@@ -237,14 +252,57 @@ established :: Internal -> Connection -> EventStore () established self@Internal{..} conn =   readIORef _stage >>= \case-    Connecting _ (ConnectionEstablishing known) -> do+    Connecting att (ConnectionEstablishing known) -> do       when (conn == known) $ do         $logDebug [i|TCP connection established: #{conn}.|]-        atomicWriteIORef _stage (Connected conn)-        initHeartbeatTracker self+        setts <- getSettings+        case s_defaultUserCredentials setts of+          Just cred -> authenticate self att conn cred+          Nothing   -> identifyClient self att known     _ -> return ()  --------------------------------------------------------------------------------+authenticate :: Internal+             -> Attempts+             -> Connection+             -> Credentials+             -> EventStore ()+authenticate Internal{..} att conn cred = do+  pkg     <- newAuthenticatePkg cred+  elapsed <- stopwatchElapsed _stopwatch+  let authCorr = packageCorrelation pkg++  atomicWriteIORef _stage (Connecting att (Authentication authCorr elapsed conn))+  enqueuePackage conn pkg++--------------------------------------------------------------------------------+identifyClient :: Internal -> Attempts -> Connection -> EventStore ()+identifyClient Internal{..} att conn = do+  setts <- getSettings+  uuid  <- newUUID+  let defName  = [i|ES-#{uuid}|]+      connName = fromMaybe defName (s_defaultConnectionName setts)++  pkg     <- newIdentifyPkg clientVersion connName+  elapsed <- stopwatchElapsed _stopwatch+  let idCorr = packageCorrelation pkg++  atomicWriteIORef _stage (Connecting att (Identification idCorr elapsed conn))+  enqueuePackage conn pkg+  where+    clientVersion = 1++--------------------------------------------------------------------------------+clientIdentified :: Internal -> EventStore ()+clientIdentified self@Internal{..} =+  readIORef _stage >>= \case+    Connecting _ (Identification _ _ conn) -> do+      $logDebug [i|TCP connection identified: #{conn}.|]+      atomicWriteIORef _stage (Connected conn)+      initHeartbeatTracker self+    _ -> pure ()++-------------------------------------------------------------------------------- onEstablished :: Internal -> ConnectionEstablished -> EventStore () onEstablished self (ConnectionEstablished conn) = established self conn @@ -314,21 +372,31 @@ onTick self@Internal{..} _ = do   setts <- getSettings   readIORef _stage >>= \case-    Connecting Attempts{..} s-      | onGoingConnection s -> do-        elapsed <- stopwatchElapsed _stopwatch-        if elapsed - attemptLastStart >= s_reconnect_delay setts-          then do-            let retries = attemptCount + 1-                att     = Attempts retries elapsed-            atomicWriteIORef _stage (Connecting att Reconnecting)-            case s_retry setts of-              AtMost n-                | attemptCount <= n -> retryConnection attemptCount-                | otherwise -> maxAttemptReached-              KeepRetrying -> retryConnection attemptCount-          else return ()-      | otherwise -> manageHeartbeats self+    (onGoingConnection -> Just Attempts{..}) -> do+      elapsed <- stopwatchElapsed _stopwatch+      when (elapsed - attemptLastStart >= s_reconnect_delay setts) $ do+        let retries = attemptCount + 1+            att     = Attempts retries elapsed+        atomicWriteIORef _stage (Connecting att Reconnecting)+        case s_retry setts of+          AtMost n+            | attemptCount <= n -> retryConnection attemptCount+            | otherwise -> maxAttemptReached+          KeepRetrying -> retryConnection attemptCount++    (pendingAuthenticate -> Just (started, att, conn)) -> do+      elapsed <- stopwatchElapsed _stopwatch+      when (elapsed - started >= s_operationTimeout setts) $ do+        $logWarn "Authentication timed out."+        identifyClient self att conn++    (pendingIdentification -> Just started) -> do+      elapsed <- stopwatchElapsed _stopwatch+      when (elapsed - started >= s_operationTimeout setts) $+        closeConnection self IdentificationTimeout++    (defaultConnecting -> True) -> manageHeartbeats self+     Connected _ -> do       elapsed           <- stopwatchElapsed _stopwatch       timeoutCheckStart <- readIORef _lastCheck@@ -338,12 +406,22 @@         atomicWriteIORef _lastCheck elapsed        manageHeartbeats self+     _ -> return ()   where-    onGoingConnection Reconnecting             = True-    onGoingConnection ConnectionEstablishing{} = True-    onGoingConnection _                        = False+    onGoingConnection (Connecting att Reconnecting)             = Just att+    onGoingConnection (Connecting att ConnectionEstablishing{}) = Just att+    onGoingConnection _                                         = Nothing +    pendingIdentification (Connecting _ (Identification _ started _)) = Just started+    pendingIdentification _                                           = Nothing++    pendingAuthenticate (Connecting a (Authentication _ started c)) = Just (started, a, c)+    pendingAuthenticate _                                           = Nothing++    defaultConnecting Connecting{} = True+    defaultConnecting _            = False+     maxAttemptReached = do       closeConnection self ConnectionMaxAttemptReached       publish (FatalException ConnectionMaxAttemptReached)@@ -405,22 +483,38 @@  -------------------------------------------------------------------------------- onArrived :: Internal -> PackageArrived -> EventStore ()-onArrived self@Internal{..} (PackageArrived conn pkg@Package{..}) = do-  withConnection $ \knownConn -> do-    if knownConn == conn-      then do-        $logDebug [i|Package received:  #{pkg}.|]-        incrPackageNumber self-        handlePackage-      else do-        $logDebug [i|Package IGNORED: #{pkg}.|]+onArrived self@Internal{..} (PackageArrived conn pkg@Package{..}) =+  readIORef _stage >>= \case+    (onAuthentication -> Just att) -> do+      when (packageCmd == notAuthenticatedCmd) $+        $logWarn "Not authenticated."++      identifyClient self att conn++    (onIdentification -> True) ->+      clientIdentified self++    (runningConnection -> True) -> do+      $logDebug [i|Package received:  #{pkg}.|]+      incrPackageNumber self+      handlePackage++    _ -> $logDebug [i|Package IGNORED: #{pkg}.|]+   where-    withConnection :: (Connection -> EventStore ()) -> EventStore ()-    withConnection k = do-      readIORef _stage >>= \case-        Connecting _ (ConnectionEstablishing c) -> k c-        Connected c -> k c-        _ -> $logDebug [i|Package IGNORED: #{pkg}|]+    onIdentification (Connecting _ (Identification u _ _)) =+      packageCorrelation == u && packageCmd == clientIdentifiedCmd+    onIdentification _ = False++    onAuthentication (Connecting a (Authentication u _ _)) =+      if packageCorrelation == u && (packageCmd == authenticatedCmd || packageCmd == notAuthenticatedCmd)+      then Just a+      else Nothing+    onAuthentication _ = Nothing++    runningConnection (Connecting _ (ConnectionEstablishing c)) = conn == c+    runningConnection (Connected c) = conn == c+    runningConnection _ = False      heartbeatResponse = heartbeatResponsePackage packageCorrelation 

@@ -49,6 +49,7 @@ data Request =   Request { _requestCmd     :: !Command           , _requestPayload :: !ByteString+          , _requestCred    :: !(Maybe Credentials)           }  --------------------------------------------------------------------------------@@ -140,12 +141,12 @@            <*> newIORef mempty  ---------------------------------------------------------------------------------packageOf :: Settings -> Request -> UUID -> Package-packageOf setts Request{..} uuid =+packageOf :: Request -> UUID -> Package+packageOf Request{..} uuid =   Package { packageCmd         = _requestCmd           , packageCorrelation = uuid           , packageData        = _requestPayload-          , packageCred        = s_credentials setts+          , packageCred        = _requestCred           }  --------------------------------------------------------------------------------@@ -232,9 +233,10 @@             Await k tpe _ ->               case tpe of                 NeedUUID  -> loop . k =<< freshUUID-                NeedRemote cmd payload -> do+                NeedRemote cmd payload cred -> do                   let req = Request { _requestCmd     = cmd                                     , _requestPayload = payload+                                    , _requestCred    = cred                                     }                   atomicWriteIORef sessionStack (Required k)                   maybeConnection _regConnRef >>= \case@@ -261,8 +263,7 @@   pending <- createPending session _stopwatch (connectionId conn) (Just req)    insertPending reg uuid pending-  setts <- getSettings-  enqueuePackage conn (packageOf setts req uuid)+  enqueuePackage conn (packageOf req uuid)  -------------------------------------------------------------------------------- createPending :: MonadBaseControl IO m@@ -383,7 +384,7 @@             then do               let retry = do                     uuid <- liftBase nextRandom-                    let pkg     = packageOf setts req uuid+                    let pkg     = packageOf req uuid                         pending =                           p { _pendingLastTry = elapsed                             , _pendingRetries = _pendingRetries p + 1

@@ -53,6 +53,7 @@ -------------------------------------------------------------------------------- import Database.EventStore.Internal.Command import Database.EventStore.Internal.Prelude+import Database.EventStore.Internal.Settings import Database.EventStore.Internal.Stream import Database.EventStore.Internal.Types @@ -122,7 +123,7 @@ -------------------------------------------------------------------------------- data Need a where   NeedUUID   :: Need UUID-  NeedRemote :: Command -> ByteString -> Need Package+  NeedRemote :: Command -> ByteString -> Maybe Credentials -> Need Package   WaitRemote :: UUID -> Need (Maybe Package)  --------------------------------------------------------------------------------@@ -150,11 +151,12 @@ send :: (Encode req, Decode resp)      => Command      -> Command+     -> Maybe Credentials      -> req      -> Code o resp-send reqCmd expCmd req = do+send reqCmd expCmd cred req = do   let payload = runPut $ encodeMessage req-  pkg <- awaits $ NeedRemote reqCmd payload+  pkg <- awaits $ NeedRemote reqCmd payload cred   let gotCmd = packageCmd pkg    when (gotCmd /= expCmd)@@ -184,12 +186,13 @@ --   message along with the correlation id of the network exchange. request :: Encode req         => Command+        -> Maybe Credentials         -> req         -> [Expect o]         -> Code o ()-request reqCmd rq exps = do+request reqCmd cred rq exps = do   let payload = runPut $ encodeMessage rq-  pkg <- awaits $ NeedRemote reqCmd payload+  pkg <- awaits $ NeedRemote reqCmd payload cred   runFirstMatch pkg exps  --------------------------------------------------------------------------------

@@ -0,0 +1,29 @@+--------------------------------------------------------------------------------+-- |+-- Module    :  Database.EventStore.Internal.Operation.Authenticate+-- Copyright :  (C) 2018 Yorick Laupa+-- License   :  (see the file LICENSE)+-- Maintainer:  Yorick Laupa <yo.eight@gmail.com>+-- Stability :  experimental+-- Portability: non-portable+--+--------------------------------------------------------------------------------+module Database.EventStore.Internal.Operation.Authenticate+  ( newAuthenticatePkg ) where++--------------------------------------------------------------------------------+import Database.EventStore.Internal.Command+import Database.EventStore.Internal.Prelude+import Database.EventStore.Internal.Settings+import Database.EventStore.Internal.Types++--------------------------------------------------------------------------------+newAuthenticatePkg :: MonadBase IO m => Credentials -> m Package+newAuthenticatePkg cred = do+  uuid <- newUUID+  let pkg = Package { packageCmd         = authenticateCmd+                    , packageCorrelation = uuid+                    , packageData        = ""+                    , packageCred        = Just cred+                    }+  pure pkg

@@ -52,7 +52,7 @@ -------------------------------------------------------------------------------- -- | Catchup operation state. data CatchupState-    = RegularCatchup Text Int32+    = RegularCatchup Text Int64       -- ^ Indicates the stream name and the next event number to start from.     | AllCatchup Position       -- ^ Indicates the commit and prepare position. Used when catching up from@@ -60,16 +60,21 @@     deriving Show  ---------------------------------------------------------------------------------fetch :: Settings -> Int32 -> Bool -> CatchupState -> Code o SomeSlice-fetch setts batch tos state =+fetch :: Settings+      -> Int32+      -> Bool+      -> CatchupState+      -> Maybe Credentials+      -> Code o SomeSlice+fetch setts batch tos state cred =     case state of         RegularCatchup stream n -> do             outcome <- deconstruct $ fmap Left $-                           readStreamEvents setts Forward stream n batch tos+                           readStreamEvents setts Forward stream n batch tos cred             fromReadResult stream outcome (return . toSlice)         AllCatchup (Position com pre) ->             deconstruct $ fmap (Left . toSlice) $-                readAllEvents setts com pre batch tos Forward+                readAllEvents setts com pre batch tos Forward cred  -------------------------------------------------------------------------------- updateState :: CatchupState -> Location -> CatchupState@@ -83,11 +88,12 @@              -> Int32              -> Bool              -> CatchupState+             -> Maybe Credentials              -> Operation SubAction-sourceStream setts batch tos start = unfoldPlan start go+sourceStream setts batch tos start cred = unfoldPlan start go   where     go state = do-        s <- fetch setts batch tos state+        s <- fetch setts batch tos state cred         traverse_ (yield . Submit) (sliceEvents s)          when (sliceEOS s)@@ -113,9 +119,10 @@         -> CatchupState         -> Bool         -> Maybe Int32+        -> Maybe Credentials         -> Operation SubAction-catchup setts state tos batchSiz =-    sourceStream setts batch tos state <> volatile stream tos+catchup setts state tos batchSiz cred =+    sourceStream setts batch tos state cred <> volatile stream tos cred   where     batch  = fromMaybe defaultBatchSize batchSiz     stream = catchupStreamName state

@@ -43,10 +43,11 @@              -> Text              -> ExpectedVersion              -> Maybe Bool+             -> Maybe Credentials              -> Operation DeleteResult-deleteStream Settings{..} s v hard = construct $ do-    let msg = newRequest s (expVersionInt32 v) s_requireMaster hard-    resp <- send deleteStreamCmd deleteStreamCompletedCmd msg+deleteStream Settings{..} s v hard cred = construct $ do+    let msg = newRequest s (expVersionInt64 v) s_requireMaster hard+    resp <- send deleteStreamCmd deleteStreamCompletedCmd cred msg     let r            = getField $ _result resp         com_pos      = getField $ _commitPosition resp         prep_pos     = getField $ _preparePosition resp

@@ -28,7 +28,7 @@ data Request     = Request       { _streamId        :: Required 1 (Value Text)-      , _expectedVersion :: Required 2 (Value Int32)+      , _expectedVersion :: Required 2 (Value Int64)       , _requireMaster   :: Required 3 (Value Bool)       , _hardDelete      :: Optional 4 (Value Bool)       }@@ -39,7 +39,7 @@  -------------------------------------------------------------------------------- -- | 'Request' smart constructor.-newRequest :: Text -> Int32 -> Bool -> Maybe Bool -> Request+newRequest :: Text -> Int64 -> Bool -> Maybe Bool -> Request newRequest stream_id exp_ver req_master hard_delete =     Request     { _streamId        = putField stream_id

@@ -0,0 +1,52 @@+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE DataKinds     #-}+--------------------------------------------------------------------------------+-- |+-- Module    :  Database.EventStore.Internal.Operation.Identify+-- Copyright :  (C) 2017 Yorick Laupa+-- License   :  (see the file LICENSE)+-- Maintainer:  Yorick Laupa <yo.eight@gmail.com>+-- Stability :  experimental+-- Portability: non-portable+--+--------------------------------------------------------------------------------+module Database.EventStore.Internal.Operation.Identify ( newIdentifyPkg ) where++--------------------------------------------------------------------------------+import Data.ProtocolBuffers+import Data.Serialize (runPut)++--------------------------------------------------------------------------------+import Database.EventStore.Internal.Command+import Database.EventStore.Internal.Prelude+import Database.EventStore.Internal.Types++--------------------------------------------------------------------------------+data Request =+  Request { _version :: Required 1 (Value Int32)+          , _name    :: Optional 2 (Value Text)+          } deriving (Generic, Show)++--------------------------------------------------------------------------------+newRequest :: Int32 -> Text -> Request+newRequest ver name =+  Request { _version = putField ver+          , _name    = putField $ Just name+          }++--------------------------------------------------------------------------------+newIdentifyPkg :: MonadBase IO m => Int32 -> Text -> m Package+newIdentifyPkg version name = do+  uuid <- newUUID+  let msg = newRequest version name+      pkg = Package { packageCmd         = identifyClientCmd+                    , packageCorrelation = uuid+                    , packageData        = runPut $ encodeMessage msg+                    , packageCred        = Nothing+                    }++  pure pkg++--------------------------------------------------------------------------------+instance Encode Request+

@@ -19,19 +19,21 @@ import Database.EventStore.Internal.Command import Database.EventStore.Internal.Operation import Database.EventStore.Internal.Prelude+import Database.EventStore.Internal.Settings import Database.EventStore.Internal.Subscription.Message import Database.EventStore.Internal.Subscription.Types import Database.EventStore.Internal.Types  ---------------------------------------------------------------------------------persist :: Text -> Text -> Int32 -> Operation SubAction-persist grp stream bufSize = construct (issueRequest grp stream bufSize)+persist :: Text -> Text -> Int32 -> Maybe Credentials -> Operation SubAction+persist grp stream bufSize cred =+  construct (issueRequest grp stream bufSize cred)  ---------------------------------------------------------------------------------issueRequest :: Text -> Text -> Int32 -> Code SubAction ()-issueRequest grp stream bufSize = do+issueRequest :: Text -> Text -> Int32 -> Maybe Credentials -> Code SubAction ()+issueRequest grp stream bufSize cred = do   let req = _connectToPersistentSubscription grp stream bufSize-  request connectToPersistentSubscriptionCmd req+  request connectToPersistentSubscriptionCmd cred req     [ Expect subscriptionDroppedCmd $ \_ d ->         handleDropped d     , Expect persistentSubscriptionConfirmationCmd $ \sid c -> do

@@ -24,33 +24,35 @@ import Database.EventStore.Internal.Prelude import Database.EventStore.Internal.Subscription.Message import Database.EventStore.Internal.Subscription.Types+import Database.EventStore.Internal.Settings import Database.EventStore.Internal.Types  -------------------------------------------------------------------------------- persistOperation :: Text                  -> Text+                 -> Maybe Credentials                  -> PersistAction                  -> Operation (Maybe PersistActionException)-persistOperation grp stream tpe = construct go+persistOperation grp stream cred tpe = construct go   where     go =       case tpe of         PersistCreate ss -> do           let req = _createPersistentSubscription grp stream ss           resp <- send createPersistentSubscriptionCmd-                       createPersistentSubscriptionCompletedCmd req+                       createPersistentSubscriptionCompletedCmd cred req           let result = createRException $ getField $ cpscResult resp           yield result         PersistUpdate ss -> do           let req = _updatePersistentSubscription grp stream ss           resp <- send updatePersistentSubscriptionCmd-                       updatePersistentSubscriptionCompletedCmd req+                       updatePersistentSubscriptionCompletedCmd cred req           let result = updateRException $ getField $ upscResult resp           yield result         PersistDelete -> do           let req = _deletePersistentSubscription grp stream           resp <- send deletePersistentSubscriptionCmd-                       deletePersistentSubscriptionCompletedCmd req+                       deletePersistentSubscriptionCompletedCmd cred req           let result = deleteRException $ getField $ dpscResult resp           yield result @@ -58,18 +60,23 @@ createPersist :: Text               -> Text               -> PersistentSubscriptionSettings+              -> Maybe Credentials               -> Operation (Maybe PersistActionException)-createPersist grp stream ss = persistOperation grp stream (PersistCreate ss)+createPersist grp stream ss cred =+  persistOperation grp stream cred (PersistCreate ss)  -------------------------------------------------------------------------------- updatePersist :: Text               -> Text               -> PersistentSubscriptionSettings+              -> Maybe Credentials               -> Operation (Maybe PersistActionException)-updatePersist grp stream ss = persistOperation grp stream (PersistUpdate ss)+updatePersist grp stream ss cred =+  persistOperation grp stream cred (PersistUpdate ss)  -------------------------------------------------------------------------------- deletePersist :: Text               -> Text+              -> Maybe Credentials               -> Operation (Maybe PersistActionException)-deletePersist grp stream = persistOperation grp stream PersistDelete+deletePersist grp stream cred = persistOperation grp stream cred PersistDelete

@@ -105,17 +105,17 @@ data StreamSlice =     StreamSlice     { sliceStream :: !Text-    , sliceLast   :: !Int32+    , sliceLast   :: !Int64     , _ssDir      :: !ReadDirection-    , _ssFrom     :: !Int32-    , _ssNext     :: !Int32+    , _ssFrom     :: !Int64+    , _ssNext     :: !Int64     , _ssEvents   :: ![ResolvedEvent]     , _ssEOS      :: !Bool     } deriving Show  -------------------------------------------------------------------------------- instance Slice StreamSlice where-    type Loc StreamSlice = Int32+    type Loc StreamSlice = Int64      sliceEvents    = _ssEvents     sliceDirection = _ssDir@@ -164,7 +164,7 @@  -------------------------------------------------------------------------------- data Location-    = StreamEventNumber !Int32+    = StreamEventNumber !Int64     | StreamPosition !Position     deriving Show 

@@ -38,8 +38,9 @@               -> Int32               -> Bool               -> ReadDirection+              -> Maybe Credentials               -> Operation AllSlice-readAllEvents Settings{..} c_pos p_pos max_c tos dir = construct $ do+readAllEvents Settings{..} c_pos p_pos max_c tos dir cred = construct $ do     let msg = newRequest c_pos p_pos max_c tos s_requireMaster         cmd = case dir of             Forward  -> readAllEventsForwardCmd@@ -48,7 +49,7 @@         resp_cmd = case dir of             Forward  -> readAllEventsForwardCompletedCmd             Backward -> readAllEventsBackwardCompletedCmd-    resp <- send cmd resp_cmd msg+    resp <- send cmd resp_cmd cred msg     let r      = getField $ _Result resp         err    = getField $ _Error resp         nc_pos = getField $ _NextCommitPosition resp

@@ -51,10 +51,11 @@           -> Text           -> Int32           -> Bool+          -> Maybe Credentials           -> Operation (ReadResult 'RegularStream ReadEvent)-readEvent Settings{..} s evtn tos = construct $ do+readEvent Settings{..} s evtn tos cred = construct $ do     let msg = newRequest s evtn tos s_requireMaster-    resp <- send readEventCmd readEventCompletedCmd msg+    resp <- send readEventCmd readEventCompletedCmd cred msg     let r         = getField $ _result resp         evt       = newResolvedEvent $ getField $ _indexedEvent resp         err       = getField $ _error resp

@@ -35,11 +35,12 @@ readStreamEvents :: Settings                  -> ReadDirection                  -> Text-                 -> Int32+                 -> Int64                  -> Int32                  -> Bool+                 -> Maybe Credentials                  -> Operation (ReadResult 'RegularStream StreamSlice)-readStreamEvents Settings{..} dir s st cnt tos = construct $ do+readStreamEvents Settings{..} dir s st cnt tos cred = construct $ do     let req_cmd =             case dir of                 Forward  -> readStreamEventsForwardCmd@@ -50,7 +51,7 @@                 Backward -> readStreamEventsBackwardCompletedCmd          msg = newRequest s st cnt tos s_requireMaster-    resp <- send req_cmd resp_cmd msg+    resp <- send req_cmd resp_cmd cred msg     let r     = getField $ _result resp         es    = getField $ _events resp         evts  = fmap newResolvedEvent es

@@ -28,7 +28,7 @@ data Request     = Request       { _streamId       :: Required 1 (Value Text)-      , _eventNumber    :: Required 2 (Value Int32)+      , _eventNumber    :: Required 2 (Value Int64)       , _maxCount       :: Required 3 (Value Int32)       , _resolveLinkTos :: Required 4 (Value Bool)       , _requireMaster  :: Required 5 (Value Bool)@@ -37,7 +37,7 @@  -------------------------------------------------------------------------------- -- | 'Request' smart constructor.-newRequest :: Text -> Int32 -> Int32 -> Bool -> Bool -> Request+newRequest :: Text -> Int64 -> Int32 -> Bool -> Bool -> Request newRequest stream_id evt_num max_c res_link_tos req_master =     Request     { _streamId       = putField stream_id@@ -67,8 +67,8 @@     = Response       { _events             :: Repeated 1 (Message ResolvedIndexedEvent)       , _result             :: Required 2 (Enumeration Result)-      , _nextNumber         :: Required 3 (Value Int32)-      , _lastNumber         :: Required 4 (Value Int32)+      , _nextNumber         :: Required 3 (Value Int64)+      , _lastNumber         :: Required 4 (Value Int64)       , _endOfStream        :: Required 5 (Value Bool)       , _lastCommitPosition :: Required 6 (Value Int64)       , _error              :: Optional 7 (Value Text)

@@ -42,9 +42,12 @@  -------------------------------------------------------------------------------- -- | Read stream metadata operation.-readMetaStream :: Settings -> Text -> Operation StreamMetadataResult-readMetaStream setts s = construct $ do-    let op = readEvent setts (metaStream s) (-1) False+readMetaStream :: Settings+               -> Text+               -> Maybe Credentials+               -> Operation StreamMetadataResult+readMetaStream setts s cred = construct $ do+    let op = readEvent setts (metaStream s) (-1) False cred     tmp <- deconstruct (fmap Left op)     onReadResult tmp $ \n e_num evt -> do         let bytes = recordedEventData $ resolvedEventOriginal evt@@ -57,13 +60,14 @@ setMetaStream :: Settings               -> Text               -> ExpectedVersion+              -> Maybe Credentials               -> StreamMetadata               -> Operation WriteResult-setMetaStream setts s v meta =+setMetaStream setts s v cred meta =     let stream = metaStream s         json   = streamMetadataJSON meta         evt    = createEvent StreamMetadataType Nothing (withJson json) in-     writeEvents setts stream v [evt]+     writeEvents setts stream v cred [evt]  -------------------------------------------------------------------------------- invalidFormat :: OperationError

@@ -39,10 +39,14 @@  -------------------------------------------------------------------------------- -- | Start transaction operation.-transactionStart :: Settings -> Text -> ExpectedVersion -> Operation Int64-transactionStart Settings{..} stream exp_v = construct $ do-    let msg = newStart stream (expVersionInt32 exp_v) s_requireMaster-    resp <- send transactionStartCmd transactionStartCompletedCmd msg+transactionStart :: Settings+                 -> Text+                 -> ExpectedVersion+                 -> Maybe Credentials+                 -> Operation Int64+transactionStart Settings{..} stream exp_v cred = construct $ do+    let msg = newStart stream (expVersionInt64 exp_v) s_requireMaster+    resp <- send transactionStartCmd transactionStartCompletedCmd cred msg     let tid = getField $ _transId resp         r   = getField $ _result resp     case r of@@ -62,11 +66,12 @@                  -> ExpectedVersion                  -> Int64                  -> [Event]+                 -> Maybe Credentials                  -> Operation ()-transactionWrite Settings{..} stream exp_v trans_id evts = construct $ do+transactionWrite Settings{..} stream exp_v trans_id evts cred = construct $ do     nevts <- traverse eventToNewEvent evts     let msg = newWrite trans_id nevts s_requireMaster-    resp <- send transactionWriteCmd transactionWriteCompletedCmd msg+    resp <- send transactionWriteCmd transactionWriteCompletedCmd cred msg     let r = getField $ _wwResult resp     case r of         OP_PREPARE_TIMEOUT        -> retry@@ -84,10 +89,11 @@                   -> Text                   -> ExpectedVersion                   -> Int64+                  -> Maybe Credentials                   -> Operation WriteResult-transactionCommit Settings{..} stream exp_v trans_id = construct $ do+transactionCommit Settings{..} stream exp_v trans_id cred = construct $ do     let msg = newCommit trans_id s_requireMaster-    resp <- send transactionCommitCmd transactionCommitCompletedCmd msg+    resp <- send transactionCommitCmd transactionCommitCompletedCmd cred msg     let r = getField $ _ccResult resp         com_pos = getField $ _commitPosition resp         pre_pos = getField $ _preparePosition resp

@@ -29,7 +29,7 @@ data Start =     Start     { _streamId        :: Required 1 (Value Text)-    , _expectedVersion :: Required 2 (Value Int32)+    , _expectedVersion :: Required 2 (Value Int64)     , _requireMaster   :: Required 3 (Value Bool)     }     deriving (Generic, Show)@@ -39,7 +39,7 @@  -------------------------------------------------------------------------------- -- | 'Start' smart constructor.-newStart :: Text -> Int32 -> Bool -> Start+newStart :: Text -> Int64 -> Bool -> Start newStart stream_id exp_ver req_master =     Start     { _streamId        = putField stream_id@@ -124,8 +124,8 @@     { _ccTransId       :: Required 1 (Value Int64)     , _ccResult        :: Required 2 (Enumeration OpResult)     , _ccMessage       :: Optional 3 (Value Text)-    , _firstNumber     :: Required 4 (Value Int32)-    , _lastNumber      :: Required 5 (Value Int32)+    , _firstNumber     :: Required 4 (Value Int64)+    , _lastNumber      :: Required 5 (Value Int64)     , _preparePosition :: Optional 6 (Value Int64)     , _commitPosition  :: Optional 7 (Value Int64)     }

@@ -19,19 +19,20 @@ import Database.EventStore.Internal.Command import Database.EventStore.Internal.Operation import Database.EventStore.Internal.Prelude+import Database.EventStore.Internal.Settings import Database.EventStore.Internal.Subscription.Message import Database.EventStore.Internal.Subscription.Types import Database.EventStore.Internal.Types  ---------------------------------------------------------------------------------volatile :: Text -> Bool -> Operation SubAction-volatile stream tos = construct (issueRequest stream tos)+volatile :: Text -> Bool -> Maybe Credentials -> Operation SubAction+volatile stream tos cred = construct (issueRequest stream tos cred)  ---------------------------------------------------------------------------------issueRequest :: Text -> Bool -> Code SubAction ()-issueRequest stream tos = do+issueRequest :: Text -> Bool -> Maybe Credentials -> Code SubAction ()+issueRequest stream tos cred = do   let req = subscribeToStream stream tos-  request subscribeToStreamCmd req+  request subscribeToStreamCmd cred req     [ Expect subscriptionDroppedCmd $ \_ d ->         handleDropped d     , Expect subscriptionConfirmationCmd $ \sid c -> do

@@ -23,7 +23,7 @@ -- | Returned after writing to a stream. data WriteResult     = WriteResult-      { writeNextExpectedVersion :: !Int32+      { writeNextExpectedVersion :: !Int64         -- ^ Next expected version of the stream.       , writePosition :: !Position         -- ^ 'Position' of the write.

@@ -34,12 +34,13 @@ writeEvents :: Settings             -> Text             -> ExpectedVersion+            -> Maybe Credentials             -> [Event]             -> Operation WriteResult-writeEvents Settings{..} s v evts = construct $ do+writeEvents Settings{..} s v cred evts = construct $ do     nevts <- traverse eventToNewEvent evts-    let msg = newRequest s (expVersionInt32 v) nevts s_requireMaster-    resp <- send writeEventsCmd writeEventsCompletedCmd msg+    let msg = newRequest s (expVersionInt64 v) nevts s_requireMaster+    resp <- send writeEventsCmd writeEventsCompletedCmd cred msg     let r            = getField $ _result resp         com_pos      = getField $ _commitPosition resp         prep_pos     = getField $ _preparePosition resp

@@ -29,7 +29,7 @@ data Request     = Request       { _streamId        :: Required 1 (Value Text)-      , _expectedVersion :: Required 2 (Value Int32)+      , _expectedVersion :: Required 2 (Value Int64)       , _events          :: Repeated 3 (Message NewEvent)       , _requireMaster   :: Required 4 (Value Bool)       }@@ -41,7 +41,7 @@ -------------------------------------------------------------------------------- -- | 'Request' smart constructor. newRequest :: Text        -- ^ Stream-           -> Int32       -- ^ Expected version+           -> Int64       -- ^ Expected version            -> [NewEvent]  -- ^ Events            -> Bool        -- ^ Require master            -> Request@@ -59,8 +59,8 @@     = Response       { _result          :: Required 1 (Enumeration OpResult)       , _message         :: Optional 2 (Value Text)-      , _firstNumber     :: Required 3 (Value Int32)-      , _lastNumber      :: Required 4 (Value Int32)+      , _firstNumber     :: Required 3 (Value Int64)+      , _lastNumber      :: Required 4 (Value Int64)       , _preparePosition :: Optional 5 (Value Int64)       , _commitPosition  :: Optional 6 (Value Int64)       }

@@ -21,6 +21,7 @@   , Set   , ByteString   , Text+  , UUID   , Generic   , Alternative(..)   , MonadBaseControl(..)@@ -36,6 +37,7 @@   , whenM   , isJust   , null+  , newUUID   , module Prelude   , module Control.Applicative   , module Data.Int@@ -160,6 +162,8 @@ import           Data.Set (Set) import           Data.Text (Text) import           Data.Time+import           Data.UUID (UUID)+import           Data.UUID.V4 (nextRandom)  -------------------------------------------------------------------------------- -- | Generalized version of 'STM.atomically'.@@ -183,3 +187,7 @@ -- | Only perform the action if the predicate returns 'False'. unlessM :: Monad m => m Bool -> m () -> m () unlessM mbool action = mbool >>= flip unless action++--------------------------------------------------------------------------------+newUUID :: MonadBase IO m => m UUID+newUUID = liftBase nextRandom

@@ -82,8 +82,6 @@       , s_requireMaster :: Bool         -- ^ On a cluster settings. Requires the master node when performing a         --   write operation.-      , s_credentials :: Maybe Credentials-        -- ^ 'Credentials' used for an authenticated communication.       , s_retry :: Retry         -- ^ Retry strategy when failing to connect.       , s_reconnect_delay :: NominalDiffTime@@ -103,39 +101,46 @@         -- ^ Retry strategy when an operation timeout.       , s_monitoring :: Maybe Store         -- ^ EKG metric store.+      , s_defaultConnectionName :: Maybe Text+        -- ^ Default connection name.+      , s_defaultUserCredentials :: Maybe Credentials+        -- ^ 'Credentials' to use for operations where other 'Credentials' are+        --   not explicitly supplied.       }  -------------------------------------------------------------------------------- -- | Default global settings. -----   * 's_heartbeatInterval' = 750 ms---   * 's_heartbeatTimeout'  = 1500 ms---   * 's_requireMaster'     = 'True'---   * 's_credentials'       = 'Nothing'---   * 's_retry'             = 'atMost' 3---   * 's_reconnect_delay'   = 3 seconds---   * 's_ssl'               = 'Nothing'---   * 's_loggerType'        = 'LogNone'---   * 's_loggerFilter'      = 'LoggerLevel' 'LevelInfo'---   * 's_loggerDetailed'    = 'False'---   * 's_operationTimeout'  = 10 seconds---   * 's_operationRetry'    = 'atMost' 3---   * 's_monitoring'        = 'Nothing'+--   * 's_heartbeatInterval'      = 750 ms+--   * 's_heartbeatTimeout'       = 1500 ms+--   * 's_requireMaster'          = 'True'+--   * 's_retry'                  = 'atMost' 3+--   * 's_reconnect_delay'        = 3 seconds+--   * 's_ssl'                    = 'Nothing'+--   * 's_loggerType'             = 'LogNone'+--   * 's_loggerFilter'           = 'LoggerLevel' 'LevelInfo'+--   * 's_loggerDetailed'         = 'False'+--   * 's_operationTimeout'       = 10 seconds+--   * 's_operationRetry'         = 'atMost' 3+--   * 's_monitoring'             = 'Nothing'+--   * 's_defaultConnectionName'  = 'Nothing'+--   * 's_defaultUserCredentials' = 'Nothing' defaultSettings :: Settings defaultSettings  = Settings-                   { s_heartbeatInterval = msDiffTime 750  -- 750ms-                   , s_heartbeatTimeout  = msDiffTime 1500 -- 1500ms-                   , s_requireMaster     = True-                   , s_credentials       = Nothing-                   , s_retry             = atMost 3-                   , s_reconnect_delay   = 3-                   , s_ssl               = Nothing-                   , s_loggerType        = LogNone-                   , s_loggerFilter      = LoggerLevel LevelInfo-                   , s_loggerDetailed    = False-                   , s_operationTimeout  = 10 -- secs-                   , s_operationRetry    = atMost 3-                   , s_monitoring        = Nothing+                   { s_heartbeatInterval      = msDiffTime 750  -- 750ms+                   , s_heartbeatTimeout       = msDiffTime 1500 -- 1500ms+                   , s_requireMaster          = True+                   , s_retry                  = atMost 3+                   , s_reconnect_delay        = 3+                   , s_ssl                    = Nothing+                   , s_loggerType             = LogNone+                   , s_loggerFilter           = LoggerLevel LevelInfo+                   , s_loggerDetailed         = False+                   , s_operationTimeout       = 10 -- secs+                   , s_operationRetry         = atMost 3+                   , s_monitoring             = Nothing+                   , s_defaultConnectionName  = Nothing+                   , s_defaultUserCredentials = Nothing                    }  --------------------------------------------------------------------------------

@@ -39,7 +39,7 @@  -------------------------------------------------------------------------------- data CatchupTrack-  = CatchupRegular !(Maybe Int32)+  = CatchupRegular !(Maybe Int64)   | CatchupAll !(Maybe Position)  --------------------------------------------------------------------------------@@ -108,9 +108,10 @@ newCatchupSubscription :: Exec                        -> Bool                        -> Maybe Int32+                       -> Maybe Credentials                        -> CatchupState                        -> IO CatchupSubscription-newCatchupSubscription exec tos batch state = do+newCatchupSubscription exec tos batch cred state = do   phaseVar <- newTVarIO CatchingUp   queue    <- newTQueueIO   track    <- newTVarIO $ catchupTrack state@@ -131,7 +132,7 @@           Just opE ->             case opE of               StreamNotFound{} -> do-                let op = volatile (streamText stream) tos+                let op = volatile (streamText stream) tos cred                 publishWith exec (SubmitOperation cb op)               _ -> atomically $ writeTVar phaseVar (Closed $ Left e)           _ -> atomically $ writeTVar phaseVar (Closed $ Left e)@@ -158,13 +159,13 @@                         Just p -> AllCatchup p                         _      -> state -                newOp = catchup (execSettings exec) newState tos batch+                newOp = catchup (execSettings exec) newState tos batch cred              newCb <- mfix $ \self -> newCallback (callback self)             publishWith exec (SubmitOperation newCb newOp)    cb <- mfix $ \self -> newCallback (callback self)-  let op = catchup (execSettings exec) state tos batch+  let op = catchup (execSettings exec) state tos batch cred   publishWith exec (SubmitOperation cb op)   return sub 

@@ -36,8 +36,8 @@  -------------------------------------------------------------------------------- data ConfirmationMsg-    = RegularConfirmationMsg !Int64 !(Maybe Int32)-    | PersistentConfirmationMsg !Text !Int64 !(Maybe Int32)+    = RegularConfirmationMsg !Int64 !(Maybe Int64)+    | PersistentConfirmationMsg !Text !Int64 !(Maybe Int64)  -------------------------------------------------------------------------------- confirmationCommitPos :: ConfirmationMsg -> Int64@@ -45,7 +45,7 @@ confirmationCommitPos  (PersistentConfirmationMsg _ pos _) = pos  ---------------------------------------------------------------------------------confirmationLastEventNum :: ConfirmationMsg -> Maybe Int32+confirmationLastEventNum :: ConfirmationMsg -> Maybe Int64 confirmationLastEventNum (RegularConfirmationMsg _ num)      = num confirmationLastEventNum (PersistentConfirmationMsg _ _ num) = num 

@@ -56,7 +56,7 @@ data SubscriptionConfirmation     = SubscriptionConfirmation       { subscribeLastCommitPos   :: Required 1 (Value Int64)-      , subscribeLastEventNumber :: Optional 2 (Value Int32)+      , subscribeLastEventNumber :: Optional 2 (Value Int64)       }     deriving (Generic, Show) @@ -109,7 +109,7 @@     { cpsGroupName         :: Required 1  (Value Text)     , cpsStreamId          :: Required 2  (Value Text)     , cpsResolveLinkTos    :: Required 3  (Value Bool)-    , cpsStartFrom         :: Required 4  (Value Int32)+    , cpsStartFrom         :: Required 4  (Value Int64)     , cpsMsgTimeout        :: Required 5  (Value Int32)     , cpsRecordStats       :: Required 6  (Value Bool)     , cpsLiveBufSize       :: Required 7  (Value Int32)@@ -230,7 +230,7 @@     { upsGroupName         :: Required 1  (Value Text)     , upsStreamId          :: Required 2  (Value Text)     , upsResolveLinkTos    :: Required 3  (Value Bool)-    , upsStartFrom         :: Required 4  (Value Int32)+    , upsStartFrom         :: Required 4  (Value Int64)     , upsMsgTimeout        :: Required 5  (Value Int32)     , upsRecordStats       :: Required 6  (Value Bool)     , upsLiveBufSize       :: Required 7  (Value Int32)@@ -395,7 +395,7 @@     PersistentSubscriptionConfirmation     { pscLastCommitPos :: Required 1 (Value Int64)     , pscId            :: Required 2 (Value Text)-    , pscLastEvtNumber :: Optional 3 (Value Int32)+    , pscLastEvtNumber :: Optional 3 (Value Int64)     } deriving (Generic, Show)  --------------------------------------------------------------------------------

@@ -13,9 +13,6 @@ module Database.EventStore.Internal.Subscription.Packages where  ---------------------------------------------------------------------------------import Data.Int---------------------------------------------------------------------------------- import Data.ProtocolBuffers import Data.Serialize import Data.UUID@@ -25,79 +22,17 @@ import Database.EventStore.Internal.Prelude import Database.EventStore.Internal.Settings import Database.EventStore.Internal.Subscription.Message-import Database.EventStore.Internal.Subscription.Types import Database.EventStore.Internal.Types  ----------------------------------------------------------------------------------- | Creates a regular subscription connection 'Package'.-createConnectRegularPackage :: Settings -> UUID -> Text -> Bool -> Package-createConnectRegularPackage Settings{..} uuid stream tos =-    Package-    { packageCmd         = subscribeToStreamCmd-    , packageCorrelation = uuid-    , packageData        = runPut $ encodeMessage msg-    , packageCred        = s_credentials-    }-  where-    msg = subscribeToStream stream tos------------------------------------------------------------------------------------- | Creates a persistent subscription connection 'Package'.-createConnectPersistPackage :: Settings-                            -> UUID-                            -> Text-                            -> Text-                            -> Int32-                            -> Package-createConnectPersistPackage Settings{..} uuid grp stream bufSize =-    Package-    { packageCmd         = connectToPersistentSubscriptionCmd-    , packageCorrelation = uuid-    , packageData        = runPut $ encodeMessage msg-    , packageCred        = s_credentials-    }-  where-    msg = _connectToPersistentSubscription grp stream bufSize------------------------------------------------------------------------------------- | Creates a persistent subscription 'Package'.-createPersistActionPackage :: Settings-                           -> UUID-                           -> Text-                           -> Text-                           -> PersistAction-                           -> Package-createPersistActionPackage Settings{..} u grp strm tpe =-    Package-    { packageCmd         = cmd-    , packageCorrelation = u-    , packageData        = runPut msg-    , packageCred        = s_credentials-    }-  where-    msg =-        case tpe of-            PersistCreate sett ->-                encodeMessage $ _createPersistentSubscription grp strm sett-            PersistUpdate sett ->-                encodeMessage $ _updatePersistentSubscription grp strm sett-            PersistDelete ->-                encodeMessage $ _deletePersistentSubscription grp strm-    cmd =-        case tpe of-            PersistCreate _  -> createPersistentSubscriptionCmd-            PersistUpdate _  -> updatePersistentSubscriptionCmd-            PersistDelete    -> deletePersistentSubscriptionCmd---------------------------------------------------------------------------------- -- | Creates Ack 'Package'.-createAckPackage :: Settings -> UUID -> Text -> [UUID] -> Package-createAckPackage Settings{..} corr sid eids =+createAckPackage :: Maybe Credentials -> UUID -> Text -> [UUID] -> Package+createAckPackage cred corr sid eids =     Package     { packageCmd         = persistentSubscriptionAckEventsCmd     , packageCorrelation = corr     , packageData        = runPut $ encodeMessage msg-    , packageCred        = s_credentials+    , packageCred        = cred     }   where     bytes = fmap (toStrict . toByteString) eids@@ -105,19 +40,19 @@  -------------------------------------------------------------------------------- -- | Create Nak 'Package'.-createNakPackage :: Settings+createNakPackage :: Maybe Credentials                  -> UUID                  -> Text                  -> NakAction                  -> Maybe Text                  -> [UUID]                  -> Package-createNakPackage Settings{..} corr sid act txt eids =+createNakPackage cred corr sid act txt eids =     Package     { packageCmd         = persistentSubscriptionNakEventsCmd     , packageCorrelation = corr     , packageData        = runPut $ encodeMessage msg-    , packageCred        = s_credentials+    , packageCred        = cred     }   where     bytes = fmap (toStrict . toByteString) eids@@ -133,3 +68,13 @@     , packageData        = runPut $ encodeMessage UnsubscribeFromStream     , packageCred        = Nothing     }++--------------------------------------------------------------------------------+createAuthPackage :: Credentials -> UUID -> Package+createAuthPackage cred uuid =+  Package+  { packageCmd         = authenticateCmd+  , packageCorrelation = uuid+  , packageData        = ""+  , packageCred        = Just cred+  }

@@ -43,6 +43,7 @@ data PersistentSubscription =   PersistentSubscription { _perExec   :: Exec                          , _perStream :: StreamName+                         , _perCred   :: Maybe Credentials                          , _perPhase  :: TVar Phase                          , _perNext   :: STM (Maybe ResolvedEvent)                          }@@ -70,13 +71,14 @@                           -> Text                           -> StreamName                           -> Int32+                          -> Maybe Credentials                           -> IO PersistentSubscription-newPersistentSubscription exec grp stream bufSize = do+newPersistentSubscription exec grp stream bufSize cred = do   phaseVar <- newTVarIO Pending   queue    <- newTQueueIO    let name = streamNameRaw stream-      sub  = PersistentSubscription exec stream phaseVar $ do+      sub  = PersistentSubscription exec stream cred phaseVar $ do         p       <- readTVar phaseVar         isEmpty <- isEmptyTQueue queue         if isEmpty@@ -105,7 +107,7 @@             writeTVar phaseVar (Closed $ Right SubAborted)    cb <- newCallback callback-  publishWith exec (SubmitOperation cb (persist grp name bufSize))+  publishWith exec (SubmitOperation cb (persist grp name bufSize cred))   return sub  --------------------------------------------------------------------------------@@ -122,10 +124,9 @@       Pending   -> retrySTM       Running d -> return d -  let setts    = execSettings _perExec-      uuid     = subId details+  let uuid     = subId details       Just sid = subSubId details-      pkg      = createAckPackage setts uuid sid evts+      pkg      = createAckPackage _perCred uuid sid evts   publishWith _perExec (SendPackage pkg)  --------------------------------------------------------------------------------@@ -177,8 +178,7 @@       Pending   -> retrySTM       Running d -> return d -  let setts    = execSettings _perExec-      uuid     = subId details+  let uuid     = subId details       Just sid = subSubId details-      pkg      = createNakPackage setts uuid sid act res evts+      pkg      = createNakPackage _perCred uuid sid act res evts   publishWith _perExec (SendPackage pkg)

@@ -63,8 +63,9 @@ newRegularSubscription :: Exec                        -> StreamName                        -> Bool+                       -> Maybe Credentials                        -> IO RegularSubscription-newRegularSubscription exec stream tos = do+newRegularSubscription exec stream tos cred = do   phaseVar <- newTVarIO Pending   queue    <- newTQueueIO @@ -98,5 +99,5 @@             writeTVar phaseVar (Closed $ Right SubAborted)    cb <- newCallback callback-  publishWith exec (SubmitOperation cb (volatile name tos))+  publishWith exec (SubmitOperation cb (volatile name tos cred))   return sub

@@ -67,7 +67,7 @@ data SubDetails =   SubDetails { subId           :: !UUID              , subCommitPos    :: !Int64-             , subLastEventNum :: !(Maybe Int32)+             , subLastEventNum :: !(Maybe Int64)              , subSubId        :: !(Maybe Text)              } 

@@ -1,3 +1,4 @@+{-# OPTIONS_HADDOCK hide #-} -------------------------------------------------------------------------------- -- | -- Module : Database.EventStore.Internal.Test

@@ -189,18 +189,18 @@     = Any     | NoStream     | EmptyStream-    | Exact Int32+    | Exact Int64     | StreamExists     deriving (Eq, Show)  -------------------------------------------------------------------------------- -- | Maps a 'ExpectedVersion' to an 'Int32' understandable by the server.-expVersionInt32 :: ExpectedVersion -> Int32-expVersionInt32 Any         = -2-expVersionInt32 NoStream    = -1-expVersionInt32 EmptyStream = -1-expVersionInt32 (Exact n)   = n-expVersionInt32 StreamExists = -4+expVersionInt64 :: ExpectedVersion -> Int64+expVersionInt64 Any         = -2+expVersionInt64 NoStream    = -1+expVersionInt64 EmptyStream = -1+expVersionInt64 (Exact n)   = n+expVersionInt64 StreamExists = -4  -------------------------------------------------------------------------------- -- | This write should not conflict with anything and should always succeed.@@ -222,7 +222,7 @@ -------------------------------------------------------------------------------- -- | States that the last event written to the stream should have a --   sequence number matching your expected value.-exactEventVersion :: Int32 -> ExpectedVersion+exactEventVersion :: Int64 -> ExpectedVersion exactEventVersion n     | n < 0     = error $ "expected version must be >= 0, but is " <> show n     | otherwise = Exact n@@ -277,7 +277,7 @@ data EventRecord     = EventRecord       { eventRecordStreamId     :: Required 1  (Value Text)-      , eventRecordNumber       :: Required 2  (Value Int32)+      , eventRecordNumber       :: Required 2  (Value Int64)       , eventRecordId           :: Required 3  (Value ByteString)       , eventRecordType         :: Required 4  (Value Text)       , eventRecordDataType     :: Required 5  (Value Int32)@@ -440,7 +440,7 @@         -- ^ The event stream that this event  belongs to.       , recordedEventId :: !UUID         -- ^ Unique identifier representing this event.-      , recordedEventNumber :: !Int32+      , recordedEventNumber :: !Int64         -- ^ Number of this event in the stream.       , recordedEventType :: !Text         -- ^ Type of this event.@@ -563,7 +563,7 @@  -------------------------------------------------------------------------------- -- | The event number of the original event.-resolvedEventOriginalEventNumber :: ResolvedEvent -> Int32+resolvedEventOriginalEventNumber :: ResolvedEvent -> Int64 resolvedEventOriginalEventNumber = recordedEventNumber . resolvedEventOriginal  --------------------------------------------------------------------------------@@ -1038,7 +1038,7 @@     { psSettingsResolveLinkTos :: !Bool       -- ^ Whether or not the persistent subscription should resolve linkTo       --   events to their linked events.-    , psSettingsStartFrom :: !Int32+    , psSettingsStartFrom :: !Int64       -- ^ Where the subscription should start from (position).     , psSettingsExtraStats :: !Bool       -- ^ Whether or not in depth latency statistics should be tracked on this

@@ -1,4 +1,4 @@-Copyright (c) 2014-2017, Yorick Laupa+Copyright (c) 2014-2018, Yorick Laupa  All rights reserved. 

@@ -2,7 +2,7 @@ =============================  [![Join the chat at https://gitter.im/YoEight/eventstore](https://badges.gitter.im/Join%20Chat.svg)](https://gitter.im/YoEight/eventstore?utm_source=badge&utm_medium=badge&utm_campaign=pr-badge&utm_content=badge)-[![Build Status](https://travis-ci.org/YoEight/eventstore.svg?branch=dev%2F0.15)](https://travis-ci.org/YoEight/eventstore)+[![CircleCI](https://circleci.com/gh/YoEight/eventstore/tree/dev%2F1.0.svg?style=svg)](https://circleci.com/gh/YoEight/eventstore/tree/dev%2F1.0)  That driver supports 100% of EventStore features ! More information about the GetEventStore database can be found there: https://geteventstore.com/@@ -12,8 +12,10 @@   * 64bits system   * GHC        >= 7.8.3   * Cabal      >= 1.18-  * EventStore >= 3.0.0 (>= 3.1.0 if you want competing consumers)+  * EventStore >= 3.0.0 (>= 3.1.0 if you want competing consumers). +*Note: If you use this client version >= to `1.1`, it will only supports EventStore >= 4.0.0.*+ Install ======= @@ -44,6 +46,8 @@ How to use ========== +This code snippet showcases client version >= `1.1`.+ ```haskell {-# LANGUAGE OverloadedStrings #-} -- That library uses `Text` pervasively. This pragma permits to use                                    -- String literal when a Text is needed.@@ -71,7 +75,7 @@         evt = createEvent "programming" Nothing (withJson js)      -- Appends an event to a stream named `languages`.-    as <- sendEvent conn "languages" anyVersion evt+    as <- sendEvent conn "languages" anyVersion evt Nothing      -- EventStore interactions are fundamentally asynchronous. Nothing requires you to wait     -- for the completion of an operation, but it's good to know if something went wrong.@@ -88,7 +92,7 @@ ``` Notes =====-That library was tested on Linux and OSX Yosemite.+That library was tested on Linux and OSX.  Contributions and bug reports are welcome! 

@@ -1,5 +0,0 @@-#!/bin/sh--curl -o EventStore-OSS-MacOSX-v3.9.3.tar.gz http://download.geteventstore.com/binaries/EventStore-OSS-MacOSX-v3.9.3.tar.gz-tar -xf EventStore-OSS-MacOSX-v3.9.3.tar.gz-EventStore-OSS-MacOSX-v3.9.3/run-node.sh --mem-db &

@@ -1,5 +0,0 @@-#!/bin/sh--wget http://download.geteventstore.com/binaries/EventStore-OSS-Ubuntu-14.04-v3.9.3.tar.gz-tar -xf EventStore-OSS-Ubuntu-14.04-v3.9.3.tar.gz-EventStore-OSS-Ubuntu-14.04-v3.9.3/run-node.sh --mem-db &

@@ -2,12 +2,12 @@ -- -- see: https://github.com/sol/hpack ----- hash: b65398bb75c62cbf998e64b1daf5d3f9a3b8c7088fccc6c36ac00c3c26570edd+-- hash: 2eff24825c09f9fa9aef22bf2cef45c593f960ff02cdda29cc313cbcb5e4cbd9  name:           eventstore-version:        1.0.0+version:        1.1.0 synopsis:       EventStore TCP Client-description:    EventStore TCP Client <http://geteventstore.com>+description:    EventStore TCP Client <https://eventstore.org> category:       Database homepage:       https://github.com/YoEight/eventstore#readme bug-reports:    https://github.com/YoEight/eventstore/issues@@ -21,11 +21,7 @@ cabal-version:  >= 1.10  extra-source-files:-    .gitignore-    .travis.yml     CHANGELOG.markdown-    eventstore-test-setup-osx.sh-    eventstore-test-setup.sh     README.md  source-repository head@@ -46,7 +42,7 @@     , clock     , connection ==0.2.*     , containers ==0.5.*-    , dns+    , dns >=3.0.1     , dotnet-timespan     , ekg-core     , exceptions@@ -89,9 +85,11 @@       Database.EventStore.Internal.Logger       Database.EventStore.Internal.Manager.Operation.Registry       Database.EventStore.Internal.Operation+      Database.EventStore.Internal.Operation.Authenticate       Database.EventStore.Internal.Operation.Catchup       Database.EventStore.Internal.Operation.DeleteStream       Database.EventStore.Internal.Operation.DeleteStream.Message+      Database.EventStore.Internal.Operation.Identify       Database.EventStore.Internal.Operation.Persist       Database.EventStore.Internal.Operation.PersistOperations       Database.EventStore.Internal.Operation.Read.Common

@@ -45,6 +45,7 @@                               -> ConnectionBuilder respondMWithConnectionBuilder resp = ConnectionBuilder $ \ept -> do   uuid <- freshUUID+  var  <- newEmptyMVar   let conn = Connection              { connectionId = uuid              , connectionEndPoint = ept@@ -53,6 +54,9 @@                    cmd | cmd == getCommand 0x01 -> do                            let rpkg = pkg { packageCmd = getCommand 0x02 }                            publish (PackageArrived conn rpkg)+                       | cmd == identifyClientCmd -> do+                         putMVar var (packageCorrelation pkg)+                         $logDebug "[bogus] Set Identify correlation"                        | otherwise -> do                          rpkg <- liftIO $ resp ept pkg                          publish (PackageArrived conn rpkg)@@ -60,6 +64,18 @@              }    publish (ConnectionEstablished conn)+  $logDebug "[bogus] Publish ConnectionEstablished"+  _ <- fork $ do+    corrId <- readMVar var+    let idPkg = Package { packageCmd         = clientIdentifiedCmd+                        , packageCorrelation = corrId+                        , packageData        = ""+                        , packageCred        = Nothing+                        }++    -- Sends Identification response package.+    publish (PackageArrived conn idPkg)+    $logDebug "[bogus] Publish Identification response"   return conn  --------------------------------------------------------------------------------@@ -67,13 +83,29 @@ silentConnectionBuilder :: IO () -> ConnectionBuilder silentConnectionBuilder onConnect = ConnectionBuilder $ \ept -> do   uuid <- freshUUID+  var  <- newEmptyMVar   liftIO onConnect   let conn = Connection              { connectionId = uuid              , connectionEndPoint = ept-             , enqueuePackage = \_ -> return ()+             , enqueuePackage = \pkg ->+                 when (packageCmd pkg == identifyClientCmd) $ do+                   putMVar var (packageCorrelation pkg)+                   $logDebug "[bogus] Set Identify correlation"              , dispose = return ()              }    publish (ConnectionEstablished conn)+  $logDebug "[bogus] Publish ConnectionEstablished"+  _ <- fork $ do+    corrId <- readMVar var+    let idPkg = Package { packageCmd         = clientIdentifiedCmd+                        , packageCorrelation = corrId+                        , packageData        = ""+                        , packageCred        = Nothing+                        }++    -- Sends Identification response package.+    publish (PackageArrived conn idPkg)+    $logDebug "[bogus] Publish Identification response"   return conn

@@ -79,8 +79,8 @@ createConnection :: IO Connection createConnection = do     let setts = testSettings-                { s_credentials     = Just $ credentials "admin" "changeit"-                , s_reconnect_delay = 3+                { s_defaultUserCredentials = Just $ credentials "admin" "changeit"+                , s_reconnect_delay        = 3                 }      connect setts (Static "127.0.0.1" 1113)@@ -124,7 +124,7 @@         evt = createEvent "foo" Nothing $ withJson js      stream <- freshStreamId-    as <- sendEvent conn stream anyVersion evt+    as <- sendEvent conn stream anyVersion evt Nothing     _  <- wait as     return () @@ -135,9 +135,9 @@      let js  = object [ "baz" .= True ]         evt = createEvent "foo" Nothing $ withJson js-    as <- sendEvent conn stream anyVersion evt+    as <- sendEvent conn stream anyVersion evt Nothing     _  <- wait as-    bs <- readEvent conn stream 0 False+    bs <- readEvent conn stream 0 False Nothing     rs <- wait bs     case rs of         ReadSuccess re ->@@ -156,8 +156,8 @@     stream <- freshStreamId     let js  = object [ "baz" .= True ]         evt = createEvent "foo" Nothing $ withJson js-    _ <- sendEvent conn stream anyVersion evt >>= wait-    _ <- deleteStream conn stream anyVersion Nothing+    _ <- sendEvent conn stream anyVersion evt Nothing >>= wait+    _ <- deleteStream conn stream anyVersion Nothing Nothing     return ()  --------------------------------------------------------------------------------@@ -166,15 +166,15 @@     stream <- freshStreamId     let js  = object [ "baz" .= True ]         evt = createEvent "foo" Nothing $ withJson js-    t  <- startTransaction conn stream anyVersion >>= wait-    _  <- transactionWrite t [evt] >>= wait-    rs <- readEvent conn stream 0 False >>= wait+    t  <- startTransaction conn stream anyVersion Nothing >>= wait+    _  <- transactionWrite t [evt] Nothing >>= wait+    rs <- readEvent conn stream 0 False Nothing >>= wait     case rs of         ReadNoStream -> return ()         e -> fail $ "transaction-test stream is supposed to not exist "                   <> show e-    _   <- transactionCommit t >>= wait-    rs2 <- readEvent conn stream 0 False >>= wait+    _   <- transactionCommit t Nothing >>= wait+    rs2 <- readEvent conn stream 0 False Nothing >>= wait     case rs2 of         ReadSuccess re ->             case re of@@ -195,8 +195,8 @@               , object [ "bar" .= True]               ]         evts = fmap (createEvent "foo" Nothing . withJson) jss-    _  <- sendEvents conn stream anyVersion evts >>= wait-    rs <- readStreamEventsForward conn stream 0 10 False >>= wait+    _  <- sendEvents conn stream anyVersion evts Nothing >>= wait+    rs <- readStreamEventsForward conn stream 0 10 False Nothing >>= wait     case rs of         ReadSuccess sl -> do             let jss_evts = catMaybes $ fmap resolvedEventDataAsJson@@ -212,8 +212,8 @@               , object [ "bar" .= True]               ]         evts = fmap (createEvent "foo" Nothing . withJson) jss-    _  <- sendEvents conn "read-backward-test" anyVersion evts >>= wait-    rs <- readStreamEventsBackward conn "read-backward-test" 2 10 False >>= wait+    _  <- sendEvents conn "read-backward-test" anyVersion evts Nothing >>= wait+    rs <- readStreamEventsBackward conn "read-backward-test" 2 10 False Nothing >>= wait     case rs of         ReadSuccess sl -> do             let jss_evts = catMaybes $ fmap resolvedEventDataAsJson@@ -224,13 +224,13 @@ -------------------------------------------------------------------------------- readAllEventsForwardTest :: Connection -> IO () readAllEventsForwardTest conn = do-    sl <- readAllEventsForward conn positionStart 3 False >>= wait+    sl <- readAllEventsForward conn positionStart 3 False Nothing >>= wait     assertEqual "Events is not empty" False (null $ sliceEvents sl)  -------------------------------------------------------------------------------- readAllEventsBackwardTest :: Connection -> IO () readAllEventsBackwardTest conn = do-    sl <- readAllEventsBackward conn positionEnd 3 False >>= wait+    sl <- readAllEventsBackward conn positionEnd 3 False Nothing >>= wait     assertEqual "Events is not empty" False (null $ sliceEvents sl)  --------------------------------------------------------------------------------@@ -243,9 +243,9 @@               , object [ "bar" .= True]               ]         evts = fmap (createEvent "foo" Nothing . withJson) jss-    sub  <- subscribe conn stream False+    sub  <- subscribe conn stream False Nothing     _    <- waitConfirmation sub-    _    <- sendEvents conn stream anyVersion evts >>= wait+    _    <- sendEvents conn stream anyVersion evts Nothing >>= wait     let loop 3 = return []         loop i = do             e <- nextEvent sub@@ -276,10 +276,10 @@         alljss = jss <> jss2         evts   = fmap (createEvent "foo" Nothing . withJson) jss         evts2  = fmap (createEvent "foo" Nothing . withJson) jss2-    _   <- sendEvents conn stream anyVersion evts >>= wait-    sub <- subscribeFrom conn stream False Nothing (Just 1)+    _   <- sendEvents conn stream anyVersion evts Nothing >>= wait+    sub <- subscribeFrom conn stream False Nothing (Just 1) Nothing     _   <- waitConfirmation sub-    _   <- sendEvents conn stream anyVersion evts2 >>= wait+    _   <- sendEvents conn stream anyVersion evts2 Nothing >>= wait      let loop [] = do             m <- nextEventMaybe sub@@ -312,7 +312,7 @@ subscribeFromNoStreamTest :: Connection -> IO () subscribeFromNoStreamTest conn = do   stream <- freshStreamId-  sub <- subscribeFrom conn stream False Nothing Nothing+  sub <- subscribeFrom conn stream False Nothing Nothing Nothing   let loop [] = do           m <- nextEventMaybe sub           case m of@@ -334,7 +334,7 @@                evts = fmap (createEvent "foo" Nothing . withJson) jss -          _ <- sendEvents conn stream anyVersion evts >>= wait+          _ <- sendEvents conn stream anyVersion evts Nothing >>= wait           loop jss           return SubNoStreamTestSuccess       timeout = do@@ -351,7 +351,7 @@ setStreamMetadataTest conn = do     stream <- freshStreamId     let metadata = buildStreamMetadata $ setCustomProperty "foo" (1 :: Int)-    _ <- setStreamMetadata conn stream anyVersion metadata >>= wait+    _ <- setStreamMetadata conn stream anyVersion metadata Nothing >>= wait     return ()  --------------------------------------------------------------------------------@@ -359,8 +359,8 @@ getStreamMetadataTest conn = do     stream <- freshStreamId     let metadata = buildStreamMetadata $ setCustomProperty "foo" (1 :: Int)-    _ <- setStreamMetadata conn stream anyVersion metadata >>= wait-    r <- getStreamMetadata conn stream >>= wait+    _ <- setStreamMetadata conn stream anyVersion metadata Nothing >>= wait+    r <- getStreamMetadata conn stream Nothing >>= wait     case r of         StreamMetadataResult _ _ m ->             case getCustomProperty m "foo" of@@ -373,7 +373,7 @@ createPersistentTest conn = do     let def = defaultPersistentSubscriptionSettings     stream <- freshStreamId-    r <- createPersistentSubscription conn "group" stream def >>= wait+    r <- createPersistentSubscription conn "group" stream def Nothing >>= wait     case r of         Nothing -> return ()         Just e  -> fail $ "Exception arised: " <> show e@@ -383,8 +383,8 @@ updatePersistentTest conn = do     let def = defaultPersistentSubscriptionSettings     stream <- freshStreamId-    _ <- createPersistentSubscription conn "group" stream def >>= wait-    r <- updatePersistentSubscription conn "group" stream def >>= wait+    _ <- createPersistentSubscription conn "group" stream def Nothing >>= wait+    r <- updatePersistentSubscription conn "group" stream def Nothing >>= wait     case r of         Nothing -> return ()         Just e  -> fail $ "Exception arised: " <> show e@@ -394,8 +394,8 @@ deletePersistentTest conn = do     let def = defaultPersistentSubscriptionSettings     stream <- freshStreamId-    _ <- createPersistentSubscription conn "group" stream def >>= wait-    r <- deletePersistentSubscription conn "group" stream >>= wait+    _ <- createPersistentSubscription conn "group" stream def Nothing >>= wait+    r <- deletePersistentSubscription conn "group" stream Nothing >>= wait     case r of         Nothing -> return ()         Just e  -> fail $ "Exception arised: " <> show e@@ -411,9 +411,9 @@                ]         evts = fmap (createEvent "foo" Nothing . withJson) jss     stream <- freshStreamId-    _   <- createPersistentSubscription conn "group" stream def >>= wait-    _   <- sendEvents conn stream anyVersion evts >>= wait-    sub <- connectToPersistentSubscription conn "group" stream 1+    _   <- createPersistentSubscription conn "group" stream def Nothing >>= wait+    _   <- sendEvents conn stream anyVersion evts Nothing >>= wait+    sub <- connectToPersistentSubscription conn "group" stream 1 Nothing     _   <- waitConfirmation sub     r   <- nextEvent sub     case resolvedEventDataAsJson r of@@ -444,9 +444,9 @@         evt = createEvent "foo" Nothing               $ withJson (object ["type" .= (3 :: Int)])     stream <- freshStreamId-    _ <- sendEvent conn stream anyVersion evt >>= wait-    _ <- setStreamMetadata conn stream anyVersion metadata >>= wait-    r <- getStreamMetadata conn stream >>= wait+    _ <- sendEvent conn stream anyVersion evt Nothing >>= wait+    _ <- setStreamMetadata conn stream anyVersion metadata Nothing >>= wait+    r <- getStreamMetadata conn stream Nothing >>= wait     case r of         StreamMetadataResult _ _ m ->             assertEqual "Should have equal timespan" (Just timespan)

@@ -58,7 +58,7 @@     exec <- newExec testSettings bus builder testDisc      p <- newPromise-    let op = readEvent testSettings "foo" 1 True+    let op = readEvent testSettings "foo" 1 True Nothing     publishWith exec (SubmitOperation p op)      res <- takeMVar var