{-# LANGUAGE DataKinds #-}
{-# LANGUAGE RecordWildCards #-}
module Database.EventStore.Internal.Operation.ReadEvent
( ReadEvent(..)
, readEvent
) 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.ReadEvent.Message
import Database.EventStore.Internal.Operation.Read.Common
import Database.EventStore.Internal.Prelude
import Database.EventStore.Internal.Settings
import Database.EventStore.Internal.Stream
import Database.EventStore.Internal.Types
data ReadEvent
= ReadEventNotFound
{ ReadEvent -> Text
readEventStream :: !Text
, ReadEvent -> Int64
readEventNumber :: !Int64
}
| ReadEvent
{ readEventStream :: !Text
, readEventNumber :: !Int64
, ReadEvent -> ResolvedEvent
readEventResolved :: !ResolvedEvent
} deriving Int -> ReadEvent -> ShowS
[ReadEvent] -> ShowS
ReadEvent -> String
(Int -> ReadEvent -> ShowS)
-> (ReadEvent -> String)
-> ([ReadEvent] -> ShowS)
-> Show ReadEvent
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ReadEvent] -> ShowS
$cshowList :: [ReadEvent] -> ShowS
show :: ReadEvent -> String
$cshow :: ReadEvent -> String
showsPrec :: Int -> ReadEvent -> ShowS
$cshowsPrec :: Int -> ReadEvent -> ShowS
Show
readEvent
:: Settings
-> Exec
-> Text
-> Int64
-> Bool
-> Maybe Credentials
-> IO (Async (ReadResult EventNumber ReadEvent))
readEvent :: Settings
-> Exec
-> Text
-> Int64
-> Bool
-> Maybe Credentials
-> IO (Async (ReadResult EventNumber ReadEvent))
readEvent 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 Text
stream Int64
evtn Bool
tos Maybe Credentials
creds
= do Mailbox
m <- IO Mailbox
forall (m :: * -> *). MonadBase IO m => m Mailbox
mailboxNew
IO (ReadResult EventNumber ReadEvent)
-> IO (Async (StM IO (ReadResult EventNumber ReadEvent)))
forall (m :: * -> *) a.
MonadBaseControl IO m =>
m a -> m (Async (StM m a))
async (IO (ReadResult EventNumber ReadEvent)
-> IO (Async (StM IO (ReadResult EventNumber ReadEvent))))
-> IO (ReadResult EventNumber ReadEvent)
-> IO (Async (StM IO (ReadResult EventNumber ReadEvent)))
forall a b. (a -> b) -> a -> b
$
do let req :: Request
req = Text -> Int64 -> Bool -> Bool -> Request
newRequest Text
stream Int64
evtn Bool
tos Bool
s_requireMaster
Package
pkg <- Command -> Maybe Credentials -> Request -> IO Package
forall msg (m :: * -> *).
(Encode msg, MonadIO m) =>
Command -> Maybe Credentials -> msg -> m Package
createPkg Command
readEventCmd Maybe Credentials
creds Request
req
Exec -> Transmit -> IO ()
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 <- Mailbox -> IO (Either OperationError Response)
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
-> OperationError -> IO (ReadResult EventNumber ReadEvent)
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throw OperationError
e
Right Response
resp
-> let r :: FieldType (Field 1 (RequiredField (Always (Enumeration Result))))
r = Field 1 (RequiredField (Always (Enumeration Result)))
-> FieldType
(Field 1 (RequiredField (Always (Enumeration Result))))
forall a. HasField a => a -> FieldType a
getField (Field 1 (RequiredField (Always (Enumeration Result)))
-> FieldType
(Field 1 (RequiredField (Always (Enumeration Result)))))
-> Field 1 (RequiredField (Always (Enumeration Result)))
-> FieldType
(Field 1 (RequiredField (Always (Enumeration Result))))
forall a b. (a -> b) -> a -> b
$ Response -> Required 1 (Enumeration Result)
_result Response
resp
evt :: ResolvedEvent
evt = ResolvedIndexedEvent -> ResolvedEvent
newResolvedEvent (ResolvedIndexedEvent -> ResolvedEvent)
-> ResolvedIndexedEvent -> ResolvedEvent
forall a b. (a -> b) -> a -> b
$ Field 2 (RequiredField (Always (Message ResolvedIndexedEvent)))
-> FieldType
(Field 2 (RequiredField (Always (Message ResolvedIndexedEvent))))
forall a. HasField a => a -> FieldType a
getField (Field 2 (RequiredField (Always (Message ResolvedIndexedEvent)))
-> FieldType
(Field 2 (RequiredField (Always (Message ResolvedIndexedEvent)))))
-> Field 2 (RequiredField (Always (Message ResolvedIndexedEvent)))
-> FieldType
(Field 2 (RequiredField (Always (Message ResolvedIndexedEvent))))
forall a b. (a -> b) -> a -> b
$ Response -> Required 2 (Message ResolvedIndexedEvent)
_indexedEvent Response
resp
err :: FieldType (Field 3 (OptionalField (Last (Value Text))))
err = Field 3 (OptionalField (Last (Value Text)))
-> FieldType (Field 3 (OptionalField (Last (Value Text))))
forall a. HasField a => a -> FieldType a
getField (Field 3 (OptionalField (Last (Value Text)))
-> FieldType (Field 3 (OptionalField (Last (Value Text)))))
-> Field 3 (OptionalField (Last (Value Text)))
-> FieldType (Field 3 (OptionalField (Last (Value Text))))
forall a b. (a -> b) -> a -> b
$ Response -> Optional 3 (Value Text)
_error Response
resp
notFound :: ReadResult EventNumber ReadEvent
notFound = ReadEvent -> ReadResult EventNumber ReadEvent
forall a t. a -> ReadResult t a
ReadSuccess (ReadEvent -> ReadResult EventNumber ReadEvent)
-> ReadEvent -> ReadResult EventNumber ReadEvent
forall a b. (a -> b) -> a -> b
$ Text -> Int64 -> ReadEvent
ReadEventNotFound Text
stream Int64
evtn
found :: ReadResult EventNumber ReadEvent
found = ReadEvent -> ReadResult EventNumber ReadEvent
forall a t. a -> ReadResult t a
ReadSuccess (ReadEvent -> ReadResult EventNumber ReadEvent)
-> ReadEvent -> ReadResult EventNumber ReadEvent
forall a b. (a -> b) -> a -> b
$ Text -> Int64 -> ResolvedEvent -> ReadEvent
ReadEvent Text
stream Int64
evtn ResolvedEvent
evt in
case FieldType (Field 1 (RequiredField (Always (Enumeration Result))))
r of
FieldType (Field 1 (RequiredField (Always (Enumeration Result))))
NOT_FOUND -> ReadResult EventNumber ReadEvent
-> IO (ReadResult EventNumber ReadEvent)
forall (f :: * -> *) a. Applicative f => a -> f a
pure ReadResult EventNumber ReadEvent
notFound
FieldType (Field 1 (RequiredField (Always (Enumeration Result))))
NO_STREAM -> ReadResult EventNumber ReadEvent
-> IO (ReadResult EventNumber ReadEvent)
forall (f :: * -> *) a. Applicative f => a -> f a
pure ReadResult EventNumber ReadEvent
forall a. ReadResult EventNumber a
ReadNoStream
FieldType (Field 1 (RequiredField (Always (Enumeration Result))))
STREAM_DELETED -> ReadResult EventNumber ReadEvent
-> IO (ReadResult EventNumber ReadEvent)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ReadResult EventNumber ReadEvent
-> IO (ReadResult EventNumber ReadEvent))
-> ReadResult EventNumber ReadEvent
-> IO (ReadResult EventNumber ReadEvent)
forall a b. (a -> b) -> a -> b
$ StreamName -> ReadResult EventNumber ReadEvent
forall a. StreamName -> ReadResult EventNumber a
ReadStreamDeleted (StreamName -> ReadResult EventNumber ReadEvent)
-> StreamName -> ReadResult EventNumber ReadEvent
forall a b. (a -> b) -> a -> b
$ Text -> StreamName
StreamName Text
stream
FieldType (Field 1 (RequiredField (Always (Enumeration Result))))
ERROR -> ReadResult EventNumber ReadEvent
-> IO (ReadResult EventNumber ReadEvent)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe Text -> ReadResult EventNumber ReadEvent
forall t a. Maybe Text -> ReadResult t a
ReadError Maybe Text
FieldType (Field 3 (OptionalField (Last (Value Text))))
err)
FieldType (Field 1 (RequiredField (Always (Enumeration Result))))
ACCESS_DENIED -> ReadResult EventNumber ReadEvent
-> IO (ReadResult EventNumber ReadEvent)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ReadResult EventNumber ReadEvent
-> IO (ReadResult EventNumber ReadEvent))
-> ReadResult EventNumber ReadEvent
-> IO (ReadResult EventNumber ReadEvent)
forall a b. (a -> b) -> a -> b
$ StreamName -> ReadResult EventNumber ReadEvent
forall t a. StreamId t -> ReadResult t a
ReadAccessDenied (StreamName -> ReadResult EventNumber ReadEvent)
-> StreamName -> ReadResult EventNumber ReadEvent
forall a b. (a -> b) -> a -> b
$ Text -> StreamName
StreamName Text
stream
FieldType (Field 1 (RequiredField (Always (Enumeration Result))))
SUCCESS -> ReadResult EventNumber ReadEvent
-> IO (ReadResult EventNumber ReadEvent)
forall (f :: * -> *) a. Applicative f => a -> f a
pure ReadResult EventNumber ReadEvent
found