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

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

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

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

--------------------------------------------------------------------------------
-- | Start transaction request.
data Start =
    Start
    { Start -> Required 1 (Value Text)
_streamId        :: Required 1 (Value Text)
    , Start -> Required 2 (Value Int64)
_expectedVersion :: Required 2 (Value Int64)
    , Start -> Required 3 (Value Bool)
_requireMaster   :: Required 3 (Value Bool)
    }
    deriving (forall x. Rep Start x -> Start
forall x. Start -> Rep Start x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Start x -> Start
$cfrom :: forall x. Start -> Rep Start x
Generic, Int -> Start -> ShowS
[Start] -> ShowS
Start -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Start] -> ShowS
$cshowList :: [Start] -> ShowS
show :: Start -> String
$cshow :: Start -> String
showsPrec :: Int -> Start -> ShowS
$cshowsPrec :: Int -> Start -> ShowS
Show)

--------------------------------------------------------------------------------
instance Encode Start

--------------------------------------------------------------------------------
-- | 'Start' smart constructor.
newStart :: Text -> Int64 -> Bool -> Start
newStart :: Text -> Int64 -> Bool -> Start
newStart Text
stream_id Int64
exp_ver Bool
req_master =
    Start
    { _streamId :: Required 1 (Value Text)
_streamId        = forall a. HasField a => FieldType a -> a
putField Text
stream_id
    , _expectedVersion :: Required 2 (Value Int64)
_expectedVersion = forall a. HasField a => FieldType a -> a
putField Int64
exp_ver
    , _requireMaster :: Required 3 (Value Bool)
_requireMaster   = forall a. HasField a => FieldType a -> a
putField Bool
req_master
    }

--------------------------------------------------------------------------------
-- | Start transaction response.
data Started =
    Started
    { Started -> Required 1 (Value Int64)
_transId :: Required 1 (Value Int64)
    , Started -> Required 2 (Enumeration OpResult)
_result  :: Required 2 (Enumeration OpResult)
    , Started -> Optional 3 (Value Text)
_message :: Optional 3 (Value Text)
    }
    deriving (forall x. Rep Started x -> Started
forall x. Started -> Rep Started x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Started x -> Started
$cfrom :: forall x. Started -> Rep Started x
Generic, Int -> Started -> ShowS
[Started] -> ShowS
Started -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Started] -> ShowS
$cshowList :: [Started] -> ShowS
show :: Started -> String
$cshow :: Started -> String
showsPrec :: Int -> Started -> ShowS
$cshowsPrec :: Int -> Started -> ShowS
Show)

--------------------------------------------------------------------------------
instance Decode Started

--------------------------------------------------------------------------------
-- | Write transactional events request.
data Write =
    Write
    { Write -> Required 1 (Value Int64)
_wTransId       :: Required 1 (Value Int64)
    , Write -> Repeated 2 (Message NewEvent)
_events         :: Repeated 2 (Message NewEvent)
    , Write -> Required 3 (Value Bool)
_wRequireMaster :: Required 3 (Value Bool)
    }
    deriving (forall x. Rep Write x -> Write
forall x. Write -> Rep Write x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Write x -> Write
$cfrom :: forall x. Write -> Rep Write x
Generic, Int -> Write -> ShowS
[Write] -> ShowS
Write -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Write] -> ShowS
$cshowList :: [Write] -> ShowS
show :: Write -> String
$cshow :: Write -> String
showsPrec :: Int -> Write -> ShowS
$cshowsPrec :: Int -> Write -> ShowS
Show)

--------------------------------------------------------------------------------
instance Encode Write

--------------------------------------------------------------------------------
-- | 'Write' smart constructor.
newWrite :: Int64 -> [NewEvent] -> Bool -> Write
newWrite :: Int64 -> [NewEvent] -> Bool -> Write
newWrite Int64
trans_id [NewEvent]
evts Bool
req_master =
    Write
    { _wTransId :: Required 1 (Value Int64)
_wTransId       = forall a. HasField a => FieldType a -> a
putField Int64
trans_id
    , _events :: Repeated 2 (Message NewEvent)
_events         = forall a. HasField a => FieldType a -> a
putField [NewEvent]
evts
    , _wRequireMaster :: Required 3 (Value Bool)
_wRequireMaster = forall a. HasField a => FieldType a -> a
putField Bool
req_master
    }

--------------------------------------------------------------------------------
-- | Write transactional events response.
data Written =
    Written
    { Written -> Required 1 (Value Int64)
_wwTransId :: Required 1 (Value Int64)
    , Written -> Required 2 (Enumeration OpResult)
_wwResult  :: Required 2 (Enumeration OpResult)
    , Written -> Optional 3 (Value Text)
_wwMessage :: Optional 3 (Value Text)
    }
    deriving (forall x. Rep Written x -> Written
forall x. Written -> Rep Written x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Written x -> Written
$cfrom :: forall x. Written -> Rep Written x
Generic, Int -> Written -> ShowS
[Written] -> ShowS
Written -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Written] -> ShowS
$cshowList :: [Written] -> ShowS
show :: Written -> String
$cshow :: Written -> String
showsPrec :: Int -> Written -> ShowS
$cshowsPrec :: Int -> Written -> ShowS
Show)

--------------------------------------------------------------------------------
instance Decode Written

--------------------------------------------------------------------------------
-- | Commit transaction request.
data Commit =
    Commit
    { Commit -> Required 1 (Value Int64)
_cTransId       :: Required 1 (Value Int64)
    , Commit -> Required 2 (Value Bool)
_cRequireMaster :: Required 2 (Value Bool)
    }
    deriving (forall x. Rep Commit x -> Commit
forall x. Commit -> Rep Commit x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Commit x -> Commit
$cfrom :: forall x. Commit -> Rep Commit x
Generic, Int -> Commit -> ShowS
[Commit] -> ShowS
Commit -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Commit] -> ShowS
$cshowList :: [Commit] -> ShowS
show :: Commit -> String
$cshow :: Commit -> String
showsPrec :: Int -> Commit -> ShowS
$cshowsPrec :: Int -> Commit -> ShowS
Show)

--------------------------------------------------------------------------------
instance Encode Commit

--------------------------------------------------------------------------------
-- | 'Commit' smart constructor.
newCommit :: Int64 -> Bool -> Commit
newCommit :: Int64 -> Bool -> Commit
newCommit Int64
trans_id Bool
req_master =
    Commit
    { _cTransId :: Required 1 (Value Int64)
_cTransId       = forall a. HasField a => FieldType a -> a
putField Int64
trans_id
    , _cRequireMaster :: Required 2 (Value Bool)
_cRequireMaster = forall a. HasField a => FieldType a -> a
putField Bool
req_master
    }

--------------------------------------------------------------------------------
-- | Commit transaction response.
data Committed =
    Committed
    { Committed -> Required 1 (Value Int64)
_ccTransId       :: Required 1 (Value Int64)
    , Committed -> Required 2 (Enumeration OpResult)
_ccResult        :: Required 2 (Enumeration OpResult)
    , Committed -> Optional 3 (Value Text)
_ccMessage       :: Optional 3 (Value Text)
    , Committed -> Required 4 (Value Int64)
_firstNumber     :: Required 4 (Value Int64)
    , Committed -> Required 5 (Value Int64)
_lastNumber      :: Required 5 (Value Int64)
    , Committed -> Optional 6 (Value Int64)
_preparePosition :: Optional 6 (Value Int64)
    , Committed -> Optional 7 (Value Int64)
_commitPosition  :: Optional 7 (Value Int64)
    }
    deriving (forall x. Rep Committed x -> Committed
forall x. Committed -> Rep Committed x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Committed x -> Committed
$cfrom :: forall x. Committed -> Rep Committed x
Generic, Int -> Committed -> ShowS
[Committed] -> ShowS
Committed -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Committed] -> ShowS
$cshowList :: [Committed] -> ShowS
show :: Committed -> String
$cshow :: Committed -> String
showsPrec :: Int -> Committed -> ShowS
$cshowsPrec :: Int -> Committed -> ShowS
Show)

--------------------------------------------------------------------------------
instance Decode Committed