{-# LANGUAGE DataKinds #-} {-# LANGUAGE RecordWildCards #-} -------------------------------------------------------------------------------- -- | -- Module : Database.EventStore.Internal.Operation.ReadStreamEvents -- Copyright : (C) 2015 Yorick Laupa -- License : (see the file LICENSE) -- -- Maintainer : Yorick Laupa -- Stability : provisional -- Portability : non-portable -- -------------------------------------------------------------------------------- module Database.EventStore.Internal.Operation.ReadStreamEvents ( readStreamEvents ) where -------------------------------------------------------------------------------- import Data.Int -------------------------------------------------------------------------------- import Data.ProtocolBuffers -------------------------------------------------------------------------------- import Database.EventStore.Internal.Command import Database.EventStore.Internal.Control (publishWith) import Database.EventStore.Internal.Communication (Transmit(..)) import Database.EventStore.Internal.Exec (Exec) import Database.EventStore.Internal.Operation import Database.EventStore.Internal.Operation.Read.Common import Database.EventStore.Internal.Operation.ReadStreamEvents.Message import Database.EventStore.Internal.Prelude import Database.EventStore.Internal.Settings import Database.EventStore.Internal.Stream import Database.EventStore.Internal.Types -------------------------------------------------------------------------------- -- | Batch read from a regular stream operation. readStreamEvents :: Settings -> Exec -> ReadDirection -> Text -> Int64 -> Int32 -> Bool -> Maybe Credentials -> IO (Async (ReadResult EventNumber StreamSlice)) readStreamEvents Settings{..} exec dir stream st cnt tos cred = do m <- mailboxNew async $ do let reqCmd = case dir of Forward -> readStreamEventsForwardCmd Backward -> readStreamEventsBackwardCmd req = newRequest stream st cnt tos s_requireMaster pkg <- createPkg reqCmd cred req publishWith exec (Transmit m OneTime pkg) outcome <- mailboxReadDecoded m case outcome of Left e -> throw e Right resp -> let r = getField $ _result resp es = getField $ _events resp evts = fmap newResolvedEvent es err = getField $ _error resp eos = getField $ _endOfStream resp nxt = getField $ _nextNumber resp found = if null evts && eos then SliceEndOfStream else Slice evts (if eos then Nothing else Just $ EventNumber nxt) in case r of NO_STREAM -> pure ReadNoStream STREAM_DELETED -> pure $ ReadStreamDeleted $ StreamName stream NOT_MODIFIED -> pure ReadNotModified ERROR -> pure (ReadError err) ACCESS_DENIED -> pure $ ReadAccessDenied $ StreamName stream SUCCESS -> pure (ReadSuccess found)