{-# LANGUAGE RecordWildCards #-}
module Database.EventStore.Internal.Operation.ReadAllEvents
( readAllEvents ) where
import Data.Int
import Data.Maybe
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.ReadAllEvents.Message
import Database.EventStore.Internal.Prelude
import Database.EventStore.Internal.Settings
import Database.EventStore.Internal.Stream
import Database.EventStore.Internal.Types
readAllEvents
:: Settings
-> Exec
-> Int64
-> Int64
-> Int32
-> Bool
-> ReadDirection
-> Maybe Credentials
-> IO (Async AllSlice)
readAllEvents Settings{..} exec c_pos p_pos max_c tos dir cred
= do m <- mailboxNew
async $
do let req = newRequest c_pos p_pos max_c tos s_requireMaster
cmd =
case dir of
Forward -> readAllEventsForwardCmd
Backward -> readAllEventsBackwardCmd
pkg <- createPkg cmd 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
err = getField $ _Error resp
nc_pos = getField $ _NextCommitPosition resp
np_pos = getField $ _NextPreparePosition resp
es = getField $ _Events resp
evts = fmap newResolvedEventFromBuf es
eos = null evts
n_pos = Position nc_pos np_pos
slice =
if eos then SliceEndOfStream else Slice evts (Just n_pos) in
case fromMaybe SUCCESS r of
ERROR -> throw $ ServerError err
ACCESS_DENIED -> throw $ AccessDenied All
_ -> pure slice