{-# LANGUAGE DataKinds       #-}
{-# LANGUAGE RecordWildCards #-}
--------------------------------------------------------------------------------
-- |
-- Module : Database.EventStore.Internal.Operation.ReadStreamEvents
-- Copyright : (C) 2015 Yorick Laupa
-- License : (see the file LICENSE)
--
-- Maintainer : Yorick Laupa <yo.eight@gmail.com>
-- 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
-> ReadDirection
-> Text
-> Int64
-> Int32
-> Bool
-> Maybe Credentials
-> IO (Async (ReadResult EventNumber StreamSlice))
readStreamEvents Settings{Bool
Maybe Text
Maybe TLSSettings
Maybe Credentials
LogType
NominalDiffTime
LoggerFilter
MonitoringBackend
Retry
s_defaultUserCredentials :: Settings -> Maybe Credentials
s_defaultConnectionName :: Settings -> Maybe Text
s_monitoring :: Settings -> MonitoringBackend
s_operationRetry :: Settings -> Retry
s_operationTimeout :: Settings -> NominalDiffTime
s_loggerDetailed :: Settings -> Bool
s_loggerFilter :: Settings -> LoggerFilter
s_loggerType :: Settings -> LogType
s_ssl :: Settings -> Maybe TLSSettings
s_reconnect_delay :: Settings -> NominalDiffTime
s_retry :: Settings -> Retry
s_requireMaster :: Settings -> Bool
s_heartbeatTimeout :: Settings -> NominalDiffTime
s_heartbeatInterval :: Settings -> NominalDiffTime
s_defaultUserCredentials :: Maybe Credentials
s_defaultConnectionName :: Maybe Text
s_monitoring :: MonitoringBackend
s_operationRetry :: Retry
s_operationTimeout :: NominalDiffTime
s_loggerDetailed :: Bool
s_loggerFilter :: LoggerFilter
s_loggerType :: LogType
s_ssl :: Maybe TLSSettings
s_reconnect_delay :: NominalDiffTime
s_retry :: Retry
s_requireMaster :: Bool
s_heartbeatTimeout :: NominalDiffTime
s_heartbeatInterval :: NominalDiffTime
..} Exec
exec ReadDirection
dir Text
stream Int64
st Int32
cnt Bool
tos Maybe Credentials
cred
  = do Mailbox
m <- forall (m :: * -> *). MonadBase IO m => m Mailbox
mailboxNew
       forall (m :: * -> *) a.
MonadBaseControl IO m =>
m a -> m (Async (StM m a))
async forall a b. (a -> b) -> a -> b
$
         do let reqCmd :: Command
reqCmd =
                  case ReadDirection
dir of
                    ReadDirection
Forward  -> Command
readStreamEventsForwardCmd
                    ReadDirection
Backward -> Command
readStreamEventsBackwardCmd

                req :: Request
req = Text -> Int64 -> Int32 -> Bool -> Bool -> Request
newRequest Text
stream Int64
st Int32
cnt Bool
tos Bool
s_requireMaster
            Package
pkg <- forall msg (m :: * -> *).
(Encode msg, MonadIO m) =>
Command -> Maybe Credentials -> msg -> m Package
createPkg Command
reqCmd Maybe Credentials
cred Request
req
            forall p a (m :: * -> *).
(Pub p, Typeable a, MonadIO m) =>
p -> a -> m ()
publishWith Exec
exec (Mailbox -> Lifetime -> Package -> Transmit
Transmit Mailbox
m Lifetime
OneTime Package
pkg)
            Either OperationError Response
outcome <- forall (m :: * -> *) resp.
(MonadBase IO m, Decode resp) =>
Mailbox -> m (Either OperationError resp)
mailboxReadDecoded Mailbox
m
            case Either OperationError Response
outcome of
              Left OperationError
e
                -> forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throw OperationError
e
              Right Response
resp
                -> let r :: FieldType (Required 2 (Enumeration Result))
r     = forall a. HasField a => a -> FieldType a
getField forall a b. (a -> b) -> a -> b
$ Response -> Required 2 (Enumeration Result)
_result Response
resp
                       es :: FieldType (Repeated 1 (Message ResolvedIndexedEvent))
es    = forall a. HasField a => a -> FieldType a
getField forall a b. (a -> b) -> a -> b
$ Response -> Repeated 1 (Message ResolvedIndexedEvent)
_events Response
resp
                       evts :: [ResolvedEvent]
evts  = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ResolvedIndexedEvent -> ResolvedEvent
newResolvedEvent FieldType (Repeated 1 (Message ResolvedIndexedEvent))
es
                       err :: FieldType (Optional 7 (Value Text))
err   = forall a. HasField a => a -> FieldType a
getField forall a b. (a -> b) -> a -> b
$ Response -> Optional 7 (Value Text)
_error Response
resp
                       eos :: FieldType (Required 5 (Value Bool))
eos   = forall a. HasField a => a -> FieldType a
getField forall a b. (a -> b) -> a -> b
$ Response -> Required 5 (Value Bool)
_endOfStream Response
resp
                       nxt :: FieldType (Required 3 (Value Int64))
nxt   = forall a. HasField a => a -> FieldType a
getField forall a b. (a -> b) -> a -> b
$ Response -> Required 3 (Value Int64)
_nextNumber Response
resp
                       found :: StreamSlice
found =
                           if forall mono. MonoFoldable mono => mono -> Bool
null [ResolvedEvent]
evts Bool -> Bool -> Bool
&& FieldType (Required 5 (Value Bool))
eos
                           then forall t. Slice t
SliceEndOfStream
                           else forall t. [ResolvedEvent] -> Maybe t -> Slice t
Slice [ResolvedEvent]
evts (if FieldType (Required 5 (Value Bool))
eos then forall a. Maybe a
Nothing else forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Int64 -> EventNumber
EventNumber FieldType (Required 3 (Value Int64))
nxt) in
                   case FieldType (Required 2 (Enumeration Result))
r of
                     FieldType (Required 2 (Enumeration Result))
Result
NO_STREAM -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. ReadResult EventNumber a
ReadNoStream
                     FieldType (Required 2 (Enumeration Result))
Result
STREAM_DELETED -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a. StreamName -> ReadResult EventNumber a
ReadStreamDeleted forall a b. (a -> b) -> a -> b
$ Text -> StreamName
StreamName Text
stream
                     FieldType (Required 2 (Enumeration Result))
Result
NOT_MODIFIED -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall t a. ReadResult t a
ReadNotModified
                     FieldType (Required 2 (Enumeration Result))
Result
ERROR -> forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall t a. Maybe Text -> ReadResult t a
ReadError FieldType (Optional 7 (Value Text))
err)
                     FieldType (Required 2 (Enumeration Result))
Result
ACCESS_DENIED -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall t a. StreamId t -> ReadResult t a
ReadAccessDenied forall a b. (a -> b) -> a -> b
$ Text -> StreamName
StreamName Text
stream
                     FieldType (Required 2 (Enumeration Result))
Result
SUCCESS -> forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall a t. a -> ReadResult t a
ReadSuccess StreamSlice
found)