module Database.EventStore.Internal.Operation.ReadEventOperation
( ReadResult(..)
, ReadEventResult(..)
, readEventOperation
) where
import Control.Concurrent
import Data.Int
import GHC.Generics (Generic)
import Data.ProtocolBuffers
import Data.Text
import Database.EventStore.Internal.Manager.Operation
import Database.EventStore.Internal.Types
data ReadEvent
= ReadEvent
{ readEventStreamId :: Required 1 (Value Text)
, readEventNumber :: Required 2 (Value Int32)
, readEventResolveLinkTos :: Required 3 (Value Bool)
, readEventRequireMaster :: Required 4 (Value Bool)
}
deriving (Generic, Show)
instance Encode ReadEvent
newReadEvent :: Text -> Int32 -> Bool -> Bool -> ReadEvent
newReadEvent stream_id evt_num res_link_tos req_master =
ReadEvent
{ readEventStreamId = putField stream_id
, readEventNumber = putField evt_num
, readEventResolveLinkTos = putField res_link_tos
, readEventRequireMaster = putField req_master
}
data ReadEventResult
= RE_SUCCESS
| RE_NOT_FOUND
| RE_NO_STREAM
| RE_STREAM_DELETED
| RE_ERROR
| RE_ACCESS_DENIED
deriving (Eq, Enum, Show)
data ReadEventCompleted
= ReadEventCompleted
{ readCompletedResult :: Required 1 (Enumeration ReadEventResult)
, readCompletedIndexedEvent :: Required 2 (Message ResolvedIndexedEvent)
, readCompletedError :: Optional 3 (Value Text)
}
deriving (Generic, Show)
instance Decode ReadEventCompleted
data ReadResult
= ReadResult
{ readResultStatus :: !ReadEventResult
, readResultStreamId :: !Text
, readResultEventNumber :: !Int32
, readResultResolvedEvent :: !(Maybe ResolvedEvent)
}
deriving Show
newReadResult :: ReadEventResult
-> Text
-> Int32
-> ResolvedIndexedEvent
-> ReadResult
newReadResult status stream_id evt_num rie = rr
where
may_re =
case status of
RE_SUCCESS -> Just $ newResolvedEvent rie
_ -> Nothing
rr = ReadResult
{ readResultStatus = status
, readResultStreamId = stream_id
, readResultEventNumber = evt_num
, readResultResolvedEvent = may_re
}
readEventOperation :: Settings
-> MVar (OperationExceptional ReadResult)
-> Text
-> Int32
-> Bool
-> OperationParams
readEventOperation settings mvar stream_id evt_num res_link_tos =
OperationParams
{ opSettings = settings
, opRequestCmd = 0xB0
, opResponseCmd = 0xB1
, opRequest =
let req_master = s_requireMaster settings
request = newReadEvent stream_id
evt_num
res_link_tos
req_master in
return request
, opSuccess = inspect mvar stream_id evt_num
, opFailure = failed mvar
}
inspect :: MVar (OperationExceptional ReadResult)
-> Text
-> Int32
-> ReadEventCompleted
-> IO Decision
inspect mvar stream_id evt_num reco = go (getField $ readCompletedResult reco)
where
may_err = getField $ readCompletedError reco
go RE_ERROR = failed mvar (ServerError may_err)
go RE_ACCESS_DENIED = failed mvar (AccessDenied stream_id)
go _ = succeed mvar stream_id evt_num reco
succeed :: MVar (OperationExceptional ReadResult)
-> Text
-> Int32
-> ReadEventCompleted
-> IO Decision
succeed mvar stream_id evt_num reco = do
putMVar mvar (Right rr)
return EndOperation
where
status = getField $ readCompletedResult reco
rie = getField $ readCompletedIndexedEvent reco
rr = newReadResult status stream_id evt_num rie
failed :: MVar (OperationExceptional ReadResult)
-> OperationException
-> IO Decision
failed mvar e = do
putMVar mvar (Left e)
return EndOperation