{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DataKinds     #-}
--------------------------------------------------------------------------------
-- |
-- Module : Database.EventStore.Internal.Operation.ReadAllEvents.Message
-- 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.ReadAllEvents.Message where

--------------------------------------------------------------------------------
import Data.Int

--------------------------------------------------------------------------------
import Data.ProtocolBuffers

--------------------------------------------------------------------------------
import Database.EventStore.Internal.Prelude
import Database.EventStore.Internal.Types

--------------------------------------------------------------------------------
-- | Batch read on $all stream request.
data Request
    = Request
      { Request -> Required 1 (Value Int64)
_commitPosition  :: Required 1 (Value Int64)
      , Request -> Required 2 (Value Int64)
_preparePosition :: Required 2 (Value Int64)
      , Request -> Required 3 (Value Int32)
_maxCount        :: Required 3 (Value Int32)
      , Request -> Required 4 (Value Bool)
_resolveLinkTos  :: Required 4 (Value Bool)
      , Request -> Required 5 (Value Bool)
_requireMaster   :: Required 5 (Value Bool)
      }
    deriving ((forall x. Request -> Rep Request x)
-> (forall x. Rep Request x -> Request) -> Generic Request
forall x. Rep Request x -> Request
forall x. Request -> Rep Request x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Request x -> Request
$cfrom :: forall x. Request -> Rep Request x
Generic, Int -> Request -> ShowS
[Request] -> ShowS
Request -> String
(Int -> Request -> ShowS)
-> (Request -> String) -> ([Request] -> ShowS) -> Show Request
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Request] -> ShowS
$cshowList :: [Request] -> ShowS
show :: Request -> String
$cshow :: Request -> String
showsPrec :: Int -> Request -> ShowS
$cshowsPrec :: Int -> Request -> ShowS
Show)

--------------------------------------------------------------------------------
instance Encode Request

--------------------------------------------------------------------------------
-- | 'Request' smart constructor.
newRequest :: Int64
           -> Int64
           -> Int32
           -> Bool
           -> Bool
           -> Request
newRequest :: Int64 -> Int64 -> Int32 -> Bool -> Bool -> Request
newRequest Int64
c_pos Int64
p_pos Int32
max_c Bool
res_link_tos Bool
req_master =
    Request :: Required 1 (Value Int64)
-> Required 2 (Value Int64)
-> Required 3 (Value Int32)
-> Required 4 (Value Bool)
-> Required 5 (Value Bool)
-> Request
Request
    { _commitPosition :: Required 1 (Value Int64)
_commitPosition  = FieldType (Field 1 (RequiredField (Always (Value Int64))))
-> Field 1 (RequiredField (Always (Value Int64)))
forall a. HasField a => FieldType a -> a
putField Int64
FieldType (Field 1 (RequiredField (Always (Value Int64))))
c_pos
    , _preparePosition :: Required 2 (Value Int64)
_preparePosition = FieldType (Field 2 (RequiredField (Always (Value Int64))))
-> Field 2 (RequiredField (Always (Value Int64)))
forall a. HasField a => FieldType a -> a
putField Int64
FieldType (Field 2 (RequiredField (Always (Value Int64))))
p_pos
    , _maxCount :: Required 3 (Value Int32)
_maxCount        = FieldType (Field 3 (RequiredField (Always (Value Int32))))
-> Field 3 (RequiredField (Always (Value Int32)))
forall a. HasField a => FieldType a -> a
putField Int32
FieldType (Field 3 (RequiredField (Always (Value Int32))))
max_c
    , _resolveLinkTos :: Required 4 (Value Bool)
_resolveLinkTos  = FieldType (Field 4 (RequiredField (Always (Value Bool))))
-> Field 4 (RequiredField (Always (Value Bool)))
forall a. HasField a => FieldType a -> a
putField Bool
FieldType (Field 4 (RequiredField (Always (Value Bool))))
res_link_tos
    , _requireMaster :: Required 5 (Value Bool)
_requireMaster   = FieldType (Field 5 (RequiredField (Always (Value Bool))))
-> Field 5 (RequiredField (Always (Value Bool)))
forall a. HasField a => FieldType a -> a
putField Bool
FieldType (Field 5 (RequiredField (Always (Value Bool))))
req_master
    }

--------------------------------------------------------------------------------
-- | Enumeration detailing the possible outcomes of reading a slice of $all
--   stream.
data Result
    = SUCCESS
    | NOT_MODIFIED
    | ERROR
    | ACCESS_DENIED
    deriving (Result -> Result -> Bool
(Result -> Result -> Bool)
-> (Result -> Result -> Bool) -> Eq Result
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Result -> Result -> Bool
$c/= :: Result -> Result -> Bool
== :: Result -> Result -> Bool
$c== :: Result -> Result -> Bool
Eq, Int -> Result
Result -> Int
Result -> [Result]
Result -> Result
Result -> Result -> [Result]
Result -> Result -> Result -> [Result]
(Result -> Result)
-> (Result -> Result)
-> (Int -> Result)
-> (Result -> Int)
-> (Result -> [Result])
-> (Result -> Result -> [Result])
-> (Result -> Result -> [Result])
-> (Result -> Result -> Result -> [Result])
-> Enum Result
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: Result -> Result -> Result -> [Result]
$cenumFromThenTo :: Result -> Result -> Result -> [Result]
enumFromTo :: Result -> Result -> [Result]
$cenumFromTo :: Result -> Result -> [Result]
enumFromThen :: Result -> Result -> [Result]
$cenumFromThen :: Result -> Result -> [Result]
enumFrom :: Result -> [Result]
$cenumFrom :: Result -> [Result]
fromEnum :: Result -> Int
$cfromEnum :: Result -> Int
toEnum :: Int -> Result
$ctoEnum :: Int -> Result
pred :: Result -> Result
$cpred :: Result -> Result
succ :: Result -> Result
$csucc :: Result -> Result
Enum, Int -> Result -> ShowS
[Result] -> ShowS
Result -> String
(Int -> Result -> ShowS)
-> (Result -> String) -> ([Result] -> ShowS) -> Show Result
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Result] -> ShowS
$cshowList :: [Result] -> ShowS
show :: Result -> String
$cshow :: Result -> String
showsPrec :: Int -> Result -> ShowS
$cshowsPrec :: Int -> Result -> ShowS
Show)

--------------------------------------------------------------------------------
-- | Batch read on $all stream response.
data Response
    = Response
      { Response -> Required 1 (Value Int64)
_CommitPosition      :: Required 1 (Value Int64)
      , Response -> Required 2 (Value Int64)
_PreparePosition     :: Required 2 (Value Int64)
      , Response -> Repeated 3 (Message ResolvedEventBuf)
_Events              :: Repeated 3 (Message ResolvedEventBuf)
      , Response -> Required 4 (Value Int64)
_NextCommitPosition  :: Required 4 (Value Int64)
      , Response -> Required 5 (Value Int64)
_NextPreparePosition :: Required 5 (Value Int64)
      , Response -> Optional 6 (Enumeration Result)
_Result              :: Optional 6 (Enumeration Result)
      , Response -> Optional 7 (Value Text)
_Error               :: Optional 7 (Value Text)
      }
    deriving ((forall x. Response -> Rep Response x)
-> (forall x. Rep Response x -> Response) -> Generic Response
forall x. Rep Response x -> Response
forall x. Response -> Rep Response x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Response x -> Response
$cfrom :: forall x. Response -> Rep Response x
Generic, Int -> Response -> ShowS
[Response] -> ShowS
Response -> String
(Int -> Response -> ShowS)
-> (Response -> String) -> ([Response] -> ShowS) -> Show Response
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Response] -> ShowS
$cshowList :: [Response] -> ShowS
show :: Response -> String
$cshow :: Response -> String
showsPrec :: Int -> Response -> ShowS
$cshowsPrec :: Int -> Response -> ShowS
Show)

--------------------------------------------------------------------------------
instance Decode Response