{-# LANGUAGE CPP           #-}
{-# LANGUAGE DataKinds     #-}
{-# LANGUAGE DeriveGeneric #-}
#if __GLASGOW_HASKELL__ < 800
{-# OPTIONS_GHC -fcontext-stack=26 #-}
#else
{-# OPTIONS_GHC -freduction-depth=26 #-}
#endif
--------------------------------------------------------------------------------
-- |
-- Module : Database.EventStore.Internal.Subscription.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.Subscription.Message where

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

--------------------------------------------------------------------------------
import Data.DotNet.TimeSpan
import Data.ProtocolBuffers

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

--------------------------------------------------------------------------------
-- | Stream subscription connection request.
data SubscribeToStream
    = SubscribeToStream
      { SubscribeToStream -> Required 1 (Value Text)
subscribeStreamId       :: Required 1 (Value Text)
      , SubscribeToStream -> Required 2 (Value Bool)
subscribeResolveLinkTos :: Required 2 (Value Bool)
      }
    deriving (forall x. Rep SubscribeToStream x -> SubscribeToStream
forall x. SubscribeToStream -> Rep SubscribeToStream x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep SubscribeToStream x -> SubscribeToStream
$cfrom :: forall x. SubscribeToStream -> Rep SubscribeToStream x
Generic, Int -> SubscribeToStream -> ShowS
[SubscribeToStream] -> ShowS
SubscribeToStream -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SubscribeToStream] -> ShowS
$cshowList :: [SubscribeToStream] -> ShowS
show :: SubscribeToStream -> String
$cshow :: SubscribeToStream -> String
showsPrec :: Int -> SubscribeToStream -> ShowS
$cshowsPrec :: Int -> SubscribeToStream -> ShowS
Show)

--------------------------------------------------------------------------------
instance Encode SubscribeToStream

--------------------------------------------------------------------------------
-- | 'SubscribeToStream' smart constructor.
subscribeToStream :: Text -> Bool -> SubscribeToStream
subscribeToStream :: Text -> Bool -> SubscribeToStream
subscribeToStream Text
stream_id Bool
res_link_tos =
    SubscribeToStream
    { subscribeStreamId :: Required 1 (Value Text)
subscribeStreamId       = forall a. HasField a => FieldType a -> a
putField Text
stream_id
    , subscribeResolveLinkTos :: Required 2 (Value Bool)
subscribeResolveLinkTos = forall a. HasField a => FieldType a -> a
putField Bool
res_link_tos
    }

--------------------------------------------------------------------------------
-- | Stream subscription connection response.
data SubscriptionConfirmation
    = SubscriptionConfirmation
      { SubscriptionConfirmation -> Required 1 (Value Int64)
subscribeLastCommitPos   :: Required 1 (Value Int64)
      , SubscriptionConfirmation -> Optional 2 (Value Int64)
subscribeLastEventNumber :: Optional 2 (Value Int64)
      }
    deriving (forall x.
Rep SubscriptionConfirmation x -> SubscriptionConfirmation
forall x.
SubscriptionConfirmation -> Rep SubscriptionConfirmation x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep SubscriptionConfirmation x -> SubscriptionConfirmation
$cfrom :: forall x.
SubscriptionConfirmation -> Rep SubscriptionConfirmation x
Generic, Int -> SubscriptionConfirmation -> ShowS
[SubscriptionConfirmation] -> ShowS
SubscriptionConfirmation -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SubscriptionConfirmation] -> ShowS
$cshowList :: [SubscriptionConfirmation] -> ShowS
show :: SubscriptionConfirmation -> String
$cshow :: SubscriptionConfirmation -> String
showsPrec :: Int -> SubscriptionConfirmation -> ShowS
$cshowsPrec :: Int -> SubscriptionConfirmation -> ShowS
Show)

--------------------------------------------------------------------------------
instance Decode SubscriptionConfirmation

--------------------------------------------------------------------------------
-- | Serialized event sent by the server when a new event has been appended to a
--   stream.
data StreamEventAppeared
    = StreamEventAppeared
      { StreamEventAppeared -> Required 1 (Message ResolvedEventBuf)
streamResolvedEvent :: Required 1 (Message ResolvedEventBuf) }
    deriving (forall x. Rep StreamEventAppeared x -> StreamEventAppeared
forall x. StreamEventAppeared -> Rep StreamEventAppeared x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep StreamEventAppeared x -> StreamEventAppeared
$cfrom :: forall x. StreamEventAppeared -> Rep StreamEventAppeared x
Generic, Int -> StreamEventAppeared -> ShowS
[StreamEventAppeared] -> ShowS
StreamEventAppeared -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [StreamEventAppeared] -> ShowS
$cshowList :: [StreamEventAppeared] -> ShowS
show :: StreamEventAppeared -> String
$cshow :: StreamEventAppeared -> String
showsPrec :: Int -> StreamEventAppeared -> ShowS
$cshowsPrec :: Int -> StreamEventAppeared -> ShowS
Show)

--------------------------------------------------------------------------------
instance Decode StreamEventAppeared

--------------------------------------------------------------------------------
-- | Represents the reason subscription drop happened.
data DropReason
    = D_Unsubscribed
    | D_AccessDenied
    | D_NotFound
    | D_PersistentSubscriptionDeleted
    | D_SubscriberMaxCountReached
    deriving (Int -> DropReason
DropReason -> Int
DropReason -> [DropReason]
DropReason -> DropReason
DropReason -> DropReason -> [DropReason]
DropReason -> DropReason -> DropReason -> [DropReason]
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 :: DropReason -> DropReason -> DropReason -> [DropReason]
$cenumFromThenTo :: DropReason -> DropReason -> DropReason -> [DropReason]
enumFromTo :: DropReason -> DropReason -> [DropReason]
$cenumFromTo :: DropReason -> DropReason -> [DropReason]
enumFromThen :: DropReason -> DropReason -> [DropReason]
$cenumFromThen :: DropReason -> DropReason -> [DropReason]
enumFrom :: DropReason -> [DropReason]
$cenumFrom :: DropReason -> [DropReason]
fromEnum :: DropReason -> Int
$cfromEnum :: DropReason -> Int
toEnum :: Int -> DropReason
$ctoEnum :: Int -> DropReason
pred :: DropReason -> DropReason
$cpred :: DropReason -> DropReason
succ :: DropReason -> DropReason
$csucc :: DropReason -> DropReason
Enum, DropReason -> DropReason -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DropReason -> DropReason -> Bool
$c/= :: DropReason -> DropReason -> Bool
== :: DropReason -> DropReason -> Bool
$c== :: DropReason -> DropReason -> Bool
Eq, Int -> DropReason -> ShowS
[DropReason] -> ShowS
DropReason -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DropReason] -> ShowS
$cshowList :: [DropReason] -> ShowS
show :: DropReason -> String
$cshow :: DropReason -> String
showsPrec :: Int -> DropReason -> ShowS
$cshowsPrec :: Int -> DropReason -> ShowS
Show)

--------------------------------------------------------------------------------
-- | A message sent by the server when a subscription has been dropped.
data SubscriptionDropped
    = SubscriptionDropped
      { SubscriptionDropped -> Optional 1 (Enumeration DropReason)
dropReason :: Optional 1 (Enumeration DropReason) }
    deriving (forall x. Rep SubscriptionDropped x -> SubscriptionDropped
forall x. SubscriptionDropped -> Rep SubscriptionDropped x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep SubscriptionDropped x -> SubscriptionDropped
$cfrom :: forall x. SubscriptionDropped -> Rep SubscriptionDropped x
Generic, Int -> SubscriptionDropped -> ShowS
[SubscriptionDropped] -> ShowS
SubscriptionDropped -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SubscriptionDropped] -> ShowS
$cshowList :: [SubscriptionDropped] -> ShowS
show :: SubscriptionDropped -> String
$cshow :: SubscriptionDropped -> String
showsPrec :: Int -> SubscriptionDropped -> ShowS
$cshowsPrec :: Int -> SubscriptionDropped -> ShowS
Show)

--------------------------------------------------------------------------------
instance Decode SubscriptionDropped

--------------------------------------------------------------------------------
-- | A message sent to the server to indicate the user asked to end a
--   subscription.
data UnsubscribeFromStream = UnsubscribeFromStream deriving (forall x. Rep UnsubscribeFromStream x -> UnsubscribeFromStream
forall x. UnsubscribeFromStream -> Rep UnsubscribeFromStream x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep UnsubscribeFromStream x -> UnsubscribeFromStream
$cfrom :: forall x. UnsubscribeFromStream -> Rep UnsubscribeFromStream x
Generic, Int -> UnsubscribeFromStream -> ShowS
[UnsubscribeFromStream] -> ShowS
UnsubscribeFromStream -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UnsubscribeFromStream] -> ShowS
$cshowList :: [UnsubscribeFromStream] -> ShowS
show :: UnsubscribeFromStream -> String
$cshow :: UnsubscribeFromStream -> String
showsPrec :: Int -> UnsubscribeFromStream -> ShowS
$cshowsPrec :: Int -> UnsubscribeFromStream -> ShowS
Show)

--------------------------------------------------------------------------------
instance Encode UnsubscribeFromStream

--------------------------------------------------------------------------------
-- | Create persistent subscription request.
data CreatePersistentSubscription =
    CreatePersistentSubscription
    { CreatePersistentSubscription -> Required 1 (Value Text)
cpsGroupName         :: Required 1  (Value Text)
    , CreatePersistentSubscription -> Required 2 (Value Text)
cpsStreamId          :: Required 2  (Value Text)
    , CreatePersistentSubscription -> Required 3 (Value Bool)
cpsResolveLinkTos    :: Required 3  (Value Bool)
    , CreatePersistentSubscription -> Required 4 (Value Int64)
cpsStartFrom         :: Required 4  (Value Int64)
    , CreatePersistentSubscription -> Required 5 (Value Int32)
cpsMsgTimeout        :: Required 5  (Value Int32)
    , CreatePersistentSubscription -> Required 6 (Value Bool)
cpsRecordStats       :: Required 6  (Value Bool)
    , CreatePersistentSubscription -> Required 7 (Value Int32)
cpsLiveBufSize       :: Required 7  (Value Int32)
    , CreatePersistentSubscription -> Required 8 (Value Int32)
cpsReadBatchSize     :: Required 8  (Value Int32)
    , CreatePersistentSubscription -> Required 9 (Value Int32)
cpsBufSize           :: Required 9  (Value Int32)
    , CreatePersistentSubscription -> Required 10 (Value Int32)
cpsMaxRetryCount     :: Required 10 (Value Int32)
    , CreatePersistentSubscription -> Required 11 (Value Bool)
cpsPreferRoundRobin  :: Required 11 (Value Bool)
    , CreatePersistentSubscription -> Required 12 (Value Int32)
cpsChkPtAfterTime    :: Required 12 (Value Int32)
    , CreatePersistentSubscription -> Required 13 (Value Int32)
cpsChkPtMaxCount     :: Required 13 (Value Int32)
    , CreatePersistentSubscription -> Required 14 (Value Int32)
cpsChkPtMinCount     :: Required 14 (Value Int32)
    , CreatePersistentSubscription -> Required 15 (Value Int32)
cpsSubMaxCount       :: Required 15 (Value Int32)
    , CreatePersistentSubscription -> Optional 16 (Value Text)
cpsNamedConsStrategy :: Optional 16 (Value Text)
    } deriving (forall x.
Rep CreatePersistentSubscription x -> CreatePersistentSubscription
forall x.
CreatePersistentSubscription -> Rep CreatePersistentSubscription x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep CreatePersistentSubscription x -> CreatePersistentSubscription
$cfrom :: forall x.
CreatePersistentSubscription -> Rep CreatePersistentSubscription x
Generic, Int -> CreatePersistentSubscription -> ShowS
[CreatePersistentSubscription] -> ShowS
CreatePersistentSubscription -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreatePersistentSubscription] -> ShowS
$cshowList :: [CreatePersistentSubscription] -> ShowS
show :: CreatePersistentSubscription -> String
$cshow :: CreatePersistentSubscription -> String
showsPrec :: Int -> CreatePersistentSubscription -> ShowS
$cshowsPrec :: Int -> CreatePersistentSubscription -> ShowS
Show)

--------------------------------------------------------------------------------
-- | 'CreatePersistentSubscription' smart constructor.
_createPersistentSubscription :: Text
                              -> Text
                              -> PersistentSubscriptionSettings
                              -> CreatePersistentSubscription
_createPersistentSubscription :: Text
-> Text
-> PersistentSubscriptionSettings
-> CreatePersistentSubscription
_createPersistentSubscription Text
group Text
stream PersistentSubscriptionSettings
sett =
    CreatePersistentSubscription
    { cpsGroupName :: Required 1 (Value Text)
cpsGroupName         = forall a. HasField a => FieldType a -> a
putField Text
group
    , cpsStreamId :: Required 2 (Value Text)
cpsStreamId          = forall a. HasField a => FieldType a -> a
putField Text
stream
    , cpsResolveLinkTos :: Required 3 (Value Bool)
cpsResolveLinkTos    = forall a. HasField a => FieldType a -> a
putField forall a b. (a -> b) -> a -> b
$ PersistentSubscriptionSettings -> Bool
psSettingsResolveLinkTos PersistentSubscriptionSettings
sett
    , cpsStartFrom :: Required 4 (Value Int64)
cpsStartFrom         = forall a. HasField a => FieldType a -> a
putField forall a b. (a -> b) -> a -> b
$ PersistentSubscriptionSettings -> Int64
psSettingsStartFrom PersistentSubscriptionSettings
sett
    , cpsMsgTimeout :: Required 5 (Value Int32)
cpsMsgTimeout        = forall a. HasField a => FieldType a -> a
putField
                             forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (Integral a, Num b) => a -> b
fromIntegral
                             forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a b. (RealFrac a, Integral b) => a -> b
truncate :: Double -> Int64)
                             forall b c a. (b -> c) -> (a -> b) -> a -> c
. TimeSpan -> Double
totalMillis
                             forall a b. (a -> b) -> a -> b
$ PersistentSubscriptionSettings -> TimeSpan
psSettingsMsgTimeout PersistentSubscriptionSettings
sett
    , cpsRecordStats :: Required 6 (Value Bool)
cpsRecordStats       = forall a. HasField a => FieldType a -> a
putField forall a b. (a -> b) -> a -> b
$ PersistentSubscriptionSettings -> Bool
psSettingsExtraStats PersistentSubscriptionSettings
sett
    , cpsLiveBufSize :: Required 7 (Value Int32)
cpsLiveBufSize       = forall a. HasField a => FieldType a -> a
putField forall a b. (a -> b) -> a -> b
$ PersistentSubscriptionSettings -> Int32
psSettingsLiveBufSize PersistentSubscriptionSettings
sett
    , cpsReadBatchSize :: Required 8 (Value Int32)
cpsReadBatchSize     = forall a. HasField a => FieldType a -> a
putField forall a b. (a -> b) -> a -> b
$ PersistentSubscriptionSettings -> Int32
psSettingsReadBatchSize PersistentSubscriptionSettings
sett
    , cpsBufSize :: Required 9 (Value Int32)
cpsBufSize           = forall a. HasField a => FieldType a -> a
putField forall a b. (a -> b) -> a -> b
$ PersistentSubscriptionSettings -> Int32
psSettingsHistoryBufSize PersistentSubscriptionSettings
sett
    , cpsMaxRetryCount :: Required 10 (Value Int32)
cpsMaxRetryCount     = forall a. HasField a => FieldType a -> a
putField forall a b. (a -> b) -> a -> b
$ PersistentSubscriptionSettings -> Int32
psSettingsMaxRetryCount PersistentSubscriptionSettings
sett
    , cpsPreferRoundRobin :: Required 11 (Value Bool)
cpsPreferRoundRobin  = forall a. HasField a => FieldType a -> a
putField Bool
False
    , cpsChkPtAfterTime :: Required 12 (Value Int32)
cpsChkPtAfterTime    = forall a. HasField a => FieldType a -> a
putField
                             forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (Integral a, Num b) => a -> b
fromIntegral
                             forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a b. (RealFrac a, Integral b) => a -> b
truncate :: Double -> Int64)
                             forall b c a. (b -> c) -> (a -> b) -> a -> c
. TimeSpan -> Double
totalMillis
                             forall a b. (a -> b) -> a -> b
$ PersistentSubscriptionSettings -> TimeSpan
psSettingsCheckPointAfter PersistentSubscriptionSettings
sett
    , cpsChkPtMaxCount :: Required 13 (Value Int32)
cpsChkPtMaxCount     = forall a. HasField a => FieldType a -> a
putField forall a b. (a -> b) -> a -> b
$ PersistentSubscriptionSettings -> Int32
psSettingsMaxCheckPointCount PersistentSubscriptionSettings
sett
    , cpsChkPtMinCount :: Required 14 (Value Int32)
cpsChkPtMinCount     = forall a. HasField a => FieldType a -> a
putField forall a b. (a -> b) -> a -> b
$ PersistentSubscriptionSettings -> Int32
psSettingsMinCheckPointCount PersistentSubscriptionSettings
sett
    , cpsSubMaxCount :: Required 15 (Value Int32)
cpsSubMaxCount       = forall a. HasField a => FieldType a -> a
putField forall a b. (a -> b) -> a -> b
$ PersistentSubscriptionSettings -> Int32
psSettingsMaxSubsCount PersistentSubscriptionSettings
sett
    , cpsNamedConsStrategy :: Optional 16 (Value Text)
cpsNamedConsStrategy = forall a. HasField a => FieldType a -> a
putField forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just Text
strText
    }
  where
    strText :: Text
strText = SystemConsumerStrategy -> Text
strategyText forall a b. (a -> b) -> a -> b
$ PersistentSubscriptionSettings -> SystemConsumerStrategy
psSettingsNamedConsumerStrategy PersistentSubscriptionSettings
sett

--------------------------------------------------------------------------------
instance Encode CreatePersistentSubscription

--------------------------------------------------------------------------------
-- | Create persistent subscription outcome.
data CreatePersistentSubscriptionResult
    = CPS_Success
    | CPS_AlreadyExists
    | CPS_Fail
    | CPS_AccessDenied
    deriving (Int -> CreatePersistentSubscriptionResult
CreatePersistentSubscriptionResult -> Int
CreatePersistentSubscriptionResult
-> [CreatePersistentSubscriptionResult]
CreatePersistentSubscriptionResult
-> CreatePersistentSubscriptionResult
CreatePersistentSubscriptionResult
-> CreatePersistentSubscriptionResult
-> [CreatePersistentSubscriptionResult]
CreatePersistentSubscriptionResult
-> CreatePersistentSubscriptionResult
-> CreatePersistentSubscriptionResult
-> [CreatePersistentSubscriptionResult]
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 :: CreatePersistentSubscriptionResult
-> CreatePersistentSubscriptionResult
-> CreatePersistentSubscriptionResult
-> [CreatePersistentSubscriptionResult]
$cenumFromThenTo :: CreatePersistentSubscriptionResult
-> CreatePersistentSubscriptionResult
-> CreatePersistentSubscriptionResult
-> [CreatePersistentSubscriptionResult]
enumFromTo :: CreatePersistentSubscriptionResult
-> CreatePersistentSubscriptionResult
-> [CreatePersistentSubscriptionResult]
$cenumFromTo :: CreatePersistentSubscriptionResult
-> CreatePersistentSubscriptionResult
-> [CreatePersistentSubscriptionResult]
enumFromThen :: CreatePersistentSubscriptionResult
-> CreatePersistentSubscriptionResult
-> [CreatePersistentSubscriptionResult]
$cenumFromThen :: CreatePersistentSubscriptionResult
-> CreatePersistentSubscriptionResult
-> [CreatePersistentSubscriptionResult]
enumFrom :: CreatePersistentSubscriptionResult
-> [CreatePersistentSubscriptionResult]
$cenumFrom :: CreatePersistentSubscriptionResult
-> [CreatePersistentSubscriptionResult]
fromEnum :: CreatePersistentSubscriptionResult -> Int
$cfromEnum :: CreatePersistentSubscriptionResult -> Int
toEnum :: Int -> CreatePersistentSubscriptionResult
$ctoEnum :: Int -> CreatePersistentSubscriptionResult
pred :: CreatePersistentSubscriptionResult
-> CreatePersistentSubscriptionResult
$cpred :: CreatePersistentSubscriptionResult
-> CreatePersistentSubscriptionResult
succ :: CreatePersistentSubscriptionResult
-> CreatePersistentSubscriptionResult
$csucc :: CreatePersistentSubscriptionResult
-> CreatePersistentSubscriptionResult
Enum, CreatePersistentSubscriptionResult
-> CreatePersistentSubscriptionResult -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreatePersistentSubscriptionResult
-> CreatePersistentSubscriptionResult -> Bool
$c/= :: CreatePersistentSubscriptionResult
-> CreatePersistentSubscriptionResult -> Bool
== :: CreatePersistentSubscriptionResult
-> CreatePersistentSubscriptionResult -> Bool
$c== :: CreatePersistentSubscriptionResult
-> CreatePersistentSubscriptionResult -> Bool
Eq, Int -> CreatePersistentSubscriptionResult -> ShowS
[CreatePersistentSubscriptionResult] -> ShowS
CreatePersistentSubscriptionResult -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreatePersistentSubscriptionResult] -> ShowS
$cshowList :: [CreatePersistentSubscriptionResult] -> ShowS
show :: CreatePersistentSubscriptionResult -> String
$cshow :: CreatePersistentSubscriptionResult -> String
showsPrec :: Int -> CreatePersistentSubscriptionResult -> ShowS
$cshowsPrec :: Int -> CreatePersistentSubscriptionResult -> ShowS
Show)

--------------------------------------------------------------------------------
-- | Create persistent subscription response.
data CreatePersistentSubscriptionCompleted =
    CreatePersistentSubscriptionCompleted
    { CreatePersistentSubscriptionCompleted
-> Required 1 (Enumeration CreatePersistentSubscriptionResult)
cpscResult :: Required 1 (Enumeration CreatePersistentSubscriptionResult)
    , CreatePersistentSubscriptionCompleted -> Optional 2 (Value Text)
cpscReason :: Optional 2 (Value Text)
    } deriving (forall x.
Rep CreatePersistentSubscriptionCompleted x
-> CreatePersistentSubscriptionCompleted
forall x.
CreatePersistentSubscriptionCompleted
-> Rep CreatePersistentSubscriptionCompleted x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep CreatePersistentSubscriptionCompleted x
-> CreatePersistentSubscriptionCompleted
$cfrom :: forall x.
CreatePersistentSubscriptionCompleted
-> Rep CreatePersistentSubscriptionCompleted x
Generic, Int -> CreatePersistentSubscriptionCompleted -> ShowS
[CreatePersistentSubscriptionCompleted] -> ShowS
CreatePersistentSubscriptionCompleted -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreatePersistentSubscriptionCompleted] -> ShowS
$cshowList :: [CreatePersistentSubscriptionCompleted] -> ShowS
show :: CreatePersistentSubscriptionCompleted -> String
$cshow :: CreatePersistentSubscriptionCompleted -> String
showsPrec :: Int -> CreatePersistentSubscriptionCompleted -> ShowS
$cshowsPrec :: Int -> CreatePersistentSubscriptionCompleted -> ShowS
Show)

--------------------------------------------------------------------------------
instance Decode CreatePersistentSubscriptionCompleted

--------------------------------------------------------------------------------
-- | Delete persistent subscription request.
data DeletePersistentSubscription =
    DeletePersistentSubscription
    { DeletePersistentSubscription -> Required 1 (Value Text)
dpsGroupName :: Required 1 (Value Text)
    , DeletePersistentSubscription -> Required 2 (Value Text)
dpsStreamId  :: Required 2 (Value Text)
    } deriving (forall x.
Rep DeletePersistentSubscription x -> DeletePersistentSubscription
forall x.
DeletePersistentSubscription -> Rep DeletePersistentSubscription x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep DeletePersistentSubscription x -> DeletePersistentSubscription
$cfrom :: forall x.
DeletePersistentSubscription -> Rep DeletePersistentSubscription x
Generic, Int -> DeletePersistentSubscription -> ShowS
[DeletePersistentSubscription] -> ShowS
DeletePersistentSubscription -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DeletePersistentSubscription] -> ShowS
$cshowList :: [DeletePersistentSubscription] -> ShowS
show :: DeletePersistentSubscription -> String
$cshow :: DeletePersistentSubscription -> String
showsPrec :: Int -> DeletePersistentSubscription -> ShowS
$cshowsPrec :: Int -> DeletePersistentSubscription -> ShowS
Show)

--------------------------------------------------------------------------------
instance Encode DeletePersistentSubscription

--------------------------------------------------------------------------------
-- | 'DeletePersistentSubscription' smart construction.
_deletePersistentSubscription :: Text -> Text -> DeletePersistentSubscription
_deletePersistentSubscription :: Text -> Text -> DeletePersistentSubscription
_deletePersistentSubscription Text
group_name Text
stream_id =
    DeletePersistentSubscription
    { dpsGroupName :: Required 1 (Value Text)
dpsGroupName = forall a. HasField a => FieldType a -> a
putField Text
group_name
    , dpsStreamId :: Required 2 (Value Text)
dpsStreamId  = forall a. HasField a => FieldType a -> a
putField Text
stream_id
    }

--------------------------------------------------------------------------------
-- | Delete persistent subscription outcome.
data DeletePersistentSubscriptionResult
    = DPS_Success
    | DPS_DoesNotExist
    | DPS_Fail
    | DPS_AccessDenied
    deriving (Int -> DeletePersistentSubscriptionResult
DeletePersistentSubscriptionResult -> Int
DeletePersistentSubscriptionResult
-> [DeletePersistentSubscriptionResult]
DeletePersistentSubscriptionResult
-> DeletePersistentSubscriptionResult
DeletePersistentSubscriptionResult
-> DeletePersistentSubscriptionResult
-> [DeletePersistentSubscriptionResult]
DeletePersistentSubscriptionResult
-> DeletePersistentSubscriptionResult
-> DeletePersistentSubscriptionResult
-> [DeletePersistentSubscriptionResult]
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 :: DeletePersistentSubscriptionResult
-> DeletePersistentSubscriptionResult
-> DeletePersistentSubscriptionResult
-> [DeletePersistentSubscriptionResult]
$cenumFromThenTo :: DeletePersistentSubscriptionResult
-> DeletePersistentSubscriptionResult
-> DeletePersistentSubscriptionResult
-> [DeletePersistentSubscriptionResult]
enumFromTo :: DeletePersistentSubscriptionResult
-> DeletePersistentSubscriptionResult
-> [DeletePersistentSubscriptionResult]
$cenumFromTo :: DeletePersistentSubscriptionResult
-> DeletePersistentSubscriptionResult
-> [DeletePersistentSubscriptionResult]
enumFromThen :: DeletePersistentSubscriptionResult
-> DeletePersistentSubscriptionResult
-> [DeletePersistentSubscriptionResult]
$cenumFromThen :: DeletePersistentSubscriptionResult
-> DeletePersistentSubscriptionResult
-> [DeletePersistentSubscriptionResult]
enumFrom :: DeletePersistentSubscriptionResult
-> [DeletePersistentSubscriptionResult]
$cenumFrom :: DeletePersistentSubscriptionResult
-> [DeletePersistentSubscriptionResult]
fromEnum :: DeletePersistentSubscriptionResult -> Int
$cfromEnum :: DeletePersistentSubscriptionResult -> Int
toEnum :: Int -> DeletePersistentSubscriptionResult
$ctoEnum :: Int -> DeletePersistentSubscriptionResult
pred :: DeletePersistentSubscriptionResult
-> DeletePersistentSubscriptionResult
$cpred :: DeletePersistentSubscriptionResult
-> DeletePersistentSubscriptionResult
succ :: DeletePersistentSubscriptionResult
-> DeletePersistentSubscriptionResult
$csucc :: DeletePersistentSubscriptionResult
-> DeletePersistentSubscriptionResult
Enum, DeletePersistentSubscriptionResult
-> DeletePersistentSubscriptionResult -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DeletePersistentSubscriptionResult
-> DeletePersistentSubscriptionResult -> Bool
$c/= :: DeletePersistentSubscriptionResult
-> DeletePersistentSubscriptionResult -> Bool
== :: DeletePersistentSubscriptionResult
-> DeletePersistentSubscriptionResult -> Bool
$c== :: DeletePersistentSubscriptionResult
-> DeletePersistentSubscriptionResult -> Bool
Eq, Int -> DeletePersistentSubscriptionResult -> ShowS
[DeletePersistentSubscriptionResult] -> ShowS
DeletePersistentSubscriptionResult -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DeletePersistentSubscriptionResult] -> ShowS
$cshowList :: [DeletePersistentSubscriptionResult] -> ShowS
show :: DeletePersistentSubscriptionResult -> String
$cshow :: DeletePersistentSubscriptionResult -> String
showsPrec :: Int -> DeletePersistentSubscriptionResult -> ShowS
$cshowsPrec :: Int -> DeletePersistentSubscriptionResult -> ShowS
Show)

--------------------------------------------------------------------------------
-- | Delete persistent subscription response.
data DeletePersistentSubscriptionCompleted =
    DeletePersistentSubscriptionCompleted
    { DeletePersistentSubscriptionCompleted
-> Required 1 (Enumeration DeletePersistentSubscriptionResult)
dpscResult :: Required 1 (Enumeration DeletePersistentSubscriptionResult)
    , DeletePersistentSubscriptionCompleted -> Optional 2 (Value Text)
dpscReason :: Optional 2 (Value Text)
    } deriving (forall x.
Rep DeletePersistentSubscriptionCompleted x
-> DeletePersistentSubscriptionCompleted
forall x.
DeletePersistentSubscriptionCompleted
-> Rep DeletePersistentSubscriptionCompleted x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep DeletePersistentSubscriptionCompleted x
-> DeletePersistentSubscriptionCompleted
$cfrom :: forall x.
DeletePersistentSubscriptionCompleted
-> Rep DeletePersistentSubscriptionCompleted x
Generic, Int -> DeletePersistentSubscriptionCompleted -> ShowS
[DeletePersistentSubscriptionCompleted] -> ShowS
DeletePersistentSubscriptionCompleted -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DeletePersistentSubscriptionCompleted] -> ShowS
$cshowList :: [DeletePersistentSubscriptionCompleted] -> ShowS
show :: DeletePersistentSubscriptionCompleted -> String
$cshow :: DeletePersistentSubscriptionCompleted -> String
showsPrec :: Int -> DeletePersistentSubscriptionCompleted -> ShowS
$cshowsPrec :: Int -> DeletePersistentSubscriptionCompleted -> ShowS
Show)

--------------------------------------------------------------------------------
instance Decode DeletePersistentSubscriptionCompleted

--------------------------------------------------------------------------------
-- | Update persistent subscription request.
data UpdatePersistentSubscription =
    UpdatePersistentSubscription
    { UpdatePersistentSubscription -> Required 1 (Value Text)
upsGroupName         :: Required 1  (Value Text)
    , UpdatePersistentSubscription -> Required 2 (Value Text)
upsStreamId          :: Required 2  (Value Text)
    , UpdatePersistentSubscription -> Required 3 (Value Bool)
upsResolveLinkTos    :: Required 3  (Value Bool)
    , UpdatePersistentSubscription -> Required 4 (Value Int64)
upsStartFrom         :: Required 4  (Value Int64)
    , UpdatePersistentSubscription -> Required 5 (Value Int32)
upsMsgTimeout        :: Required 5  (Value Int32)
    , UpdatePersistentSubscription -> Required 6 (Value Bool)
upsRecordStats       :: Required 6  (Value Bool)
    , UpdatePersistentSubscription -> Required 7 (Value Int32)
upsLiveBufSize       :: Required 7  (Value Int32)
    , UpdatePersistentSubscription -> Required 8 (Value Int32)
upsReadBatchSize     :: Required 8  (Value Int32)
    , UpdatePersistentSubscription -> Required 9 (Value Int32)
upsBufSize           :: Required 9  (Value Int32)
    , UpdatePersistentSubscription -> Required 10 (Value Int32)
upsMaxRetryCount     :: Required 10 (Value Int32)
    , UpdatePersistentSubscription -> Required 11 (Value Bool)
upsPreferRoundRobin  :: Required 11 (Value Bool)
    , UpdatePersistentSubscription -> Required 12 (Value Int32)
upsChkPtAfterTime    :: Required 12 (Value Int32)
    , UpdatePersistentSubscription -> Required 13 (Value Int32)
upsChkPtMaxCount     :: Required 13 (Value Int32)
    , UpdatePersistentSubscription -> Required 14 (Value Int32)
upsChkPtMinCount     :: Required 14 (Value Int32)
    , UpdatePersistentSubscription -> Required 15 (Value Int32)
upsSubMaxCount       :: Required 15 (Value Int32)
    , UpdatePersistentSubscription -> Optional 16 (Value Text)
upsNamedConsStrategy :: Optional 16 (Value Text)
    } deriving (forall x.
Rep UpdatePersistentSubscription x -> UpdatePersistentSubscription
forall x.
UpdatePersistentSubscription -> Rep UpdatePersistentSubscription x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep UpdatePersistentSubscription x -> UpdatePersistentSubscription
$cfrom :: forall x.
UpdatePersistentSubscription -> Rep UpdatePersistentSubscription x
Generic, Int -> UpdatePersistentSubscription -> ShowS
[UpdatePersistentSubscription] -> ShowS
UpdatePersistentSubscription -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UpdatePersistentSubscription] -> ShowS
$cshowList :: [UpdatePersistentSubscription] -> ShowS
show :: UpdatePersistentSubscription -> String
$cshow :: UpdatePersistentSubscription -> String
showsPrec :: Int -> UpdatePersistentSubscription -> ShowS
$cshowsPrec :: Int -> UpdatePersistentSubscription -> ShowS
Show)

--------------------------------------------------------------------------------
-- | 'UpdatePersistentSubscription' smart constructor.
_updatePersistentSubscription :: Text
                              -> Text
                              -> PersistentSubscriptionSettings
                              -> UpdatePersistentSubscription
_updatePersistentSubscription :: Text
-> Text
-> PersistentSubscriptionSettings
-> UpdatePersistentSubscription
_updatePersistentSubscription Text
group Text
stream PersistentSubscriptionSettings
sett =
    UpdatePersistentSubscription
    { upsGroupName :: Required 1 (Value Text)
upsGroupName         = forall a. HasField a => FieldType a -> a
putField Text
group
    , upsStreamId :: Required 2 (Value Text)
upsStreamId          = forall a. HasField a => FieldType a -> a
putField Text
stream
    , upsResolveLinkTos :: Required 3 (Value Bool)
upsResolveLinkTos    = forall a. HasField a => FieldType a -> a
putField forall a b. (a -> b) -> a -> b
$ PersistentSubscriptionSettings -> Bool
psSettingsResolveLinkTos PersistentSubscriptionSettings
sett
    , upsStartFrom :: Required 4 (Value Int64)
upsStartFrom         = forall a. HasField a => FieldType a -> a
putField forall a b. (a -> b) -> a -> b
$ PersistentSubscriptionSettings -> Int64
psSettingsStartFrom PersistentSubscriptionSettings
sett
    , upsMsgTimeout :: Required 5 (Value Int32)
upsMsgTimeout        = forall a. HasField a => FieldType a -> a
putField
                             forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (Integral a, Num b) => a -> b
fromIntegral
                             forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a b. (RealFrac a, Integral b) => a -> b
truncate :: Double -> Int64)
                             forall b c a. (b -> c) -> (a -> b) -> a -> c
. TimeSpan -> Double
totalMillis
                             forall a b. (a -> b) -> a -> b
$ PersistentSubscriptionSettings -> TimeSpan
psSettingsMsgTimeout PersistentSubscriptionSettings
sett
    , upsRecordStats :: Required 6 (Value Bool)
upsRecordStats       = forall a. HasField a => FieldType a -> a
putField forall a b. (a -> b) -> a -> b
$ PersistentSubscriptionSettings -> Bool
psSettingsExtraStats PersistentSubscriptionSettings
sett
    , upsLiveBufSize :: Required 7 (Value Int32)
upsLiveBufSize       = forall a. HasField a => FieldType a -> a
putField forall a b. (a -> b) -> a -> b
$ PersistentSubscriptionSettings -> Int32
psSettingsLiveBufSize PersistentSubscriptionSettings
sett
    , upsReadBatchSize :: Required 8 (Value Int32)
upsReadBatchSize     = forall a. HasField a => FieldType a -> a
putField forall a b. (a -> b) -> a -> b
$ PersistentSubscriptionSettings -> Int32
psSettingsReadBatchSize PersistentSubscriptionSettings
sett
    , upsBufSize :: Required 9 (Value Int32)
upsBufSize           = forall a. HasField a => FieldType a -> a
putField forall a b. (a -> b) -> a -> b
$ PersistentSubscriptionSettings -> Int32
psSettingsHistoryBufSize PersistentSubscriptionSettings
sett
    , upsMaxRetryCount :: Required 10 (Value Int32)
upsMaxRetryCount     = forall a. HasField a => FieldType a -> a
putField forall a b. (a -> b) -> a -> b
$ PersistentSubscriptionSettings -> Int32
psSettingsMaxRetryCount PersistentSubscriptionSettings
sett
    , upsPreferRoundRobin :: Required 11 (Value Bool)
upsPreferRoundRobin  = forall a. HasField a => FieldType a -> a
putField Bool
False
    , upsChkPtAfterTime :: Required 12 (Value Int32)
upsChkPtAfterTime    = forall a. HasField a => FieldType a -> a
putField
                             forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (Integral a, Num b) => a -> b
fromIntegral
                             forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a b. (RealFrac a, Integral b) => a -> b
truncate :: Double -> Int64)
                             forall b c a. (b -> c) -> (a -> b) -> a -> c
. TimeSpan -> Double
totalMillis
                             forall a b. (a -> b) -> a -> b
$ PersistentSubscriptionSettings -> TimeSpan
psSettingsCheckPointAfter PersistentSubscriptionSettings
sett
    , upsChkPtMaxCount :: Required 13 (Value Int32)
upsChkPtMaxCount     = forall a. HasField a => FieldType a -> a
putField forall a b. (a -> b) -> a -> b
$ PersistentSubscriptionSettings -> Int32
psSettingsMaxCheckPointCount PersistentSubscriptionSettings
sett
    , upsChkPtMinCount :: Required 14 (Value Int32)
upsChkPtMinCount     = forall a. HasField a => FieldType a -> a
putField forall a b. (a -> b) -> a -> b
$ PersistentSubscriptionSettings -> Int32
psSettingsMinCheckPointCount PersistentSubscriptionSettings
sett
    , upsSubMaxCount :: Required 15 (Value Int32)
upsSubMaxCount       = forall a. HasField a => FieldType a -> a
putField forall a b. (a -> b) -> a -> b
$ PersistentSubscriptionSettings -> Int32
psSettingsMaxSubsCount PersistentSubscriptionSettings
sett
    , upsNamedConsStrategy :: Optional 16 (Value Text)
upsNamedConsStrategy = forall a. HasField a => FieldType a -> a
putField forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just Text
strText
    }
  where
    strText :: Text
strText = SystemConsumerStrategy -> Text
strategyText forall a b. (a -> b) -> a -> b
$ PersistentSubscriptionSettings -> SystemConsumerStrategy
psSettingsNamedConsumerStrategy PersistentSubscriptionSettings
sett

--------------------------------------------------------------------------------
instance Encode UpdatePersistentSubscription

--------------------------------------------------------------------------------
-- | Update persistent subscription outcome.
data UpdatePersistentSubscriptionResult
    = UPS_Success
    | UPS_DoesNotExist
    | UPS_Fail
    | UPS_AccessDenied
    deriving (Int -> UpdatePersistentSubscriptionResult
UpdatePersistentSubscriptionResult -> Int
UpdatePersistentSubscriptionResult
-> [UpdatePersistentSubscriptionResult]
UpdatePersistentSubscriptionResult
-> UpdatePersistentSubscriptionResult
UpdatePersistentSubscriptionResult
-> UpdatePersistentSubscriptionResult
-> [UpdatePersistentSubscriptionResult]
UpdatePersistentSubscriptionResult
-> UpdatePersistentSubscriptionResult
-> UpdatePersistentSubscriptionResult
-> [UpdatePersistentSubscriptionResult]
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 :: UpdatePersistentSubscriptionResult
-> UpdatePersistentSubscriptionResult
-> UpdatePersistentSubscriptionResult
-> [UpdatePersistentSubscriptionResult]
$cenumFromThenTo :: UpdatePersistentSubscriptionResult
-> UpdatePersistentSubscriptionResult
-> UpdatePersistentSubscriptionResult
-> [UpdatePersistentSubscriptionResult]
enumFromTo :: UpdatePersistentSubscriptionResult
-> UpdatePersistentSubscriptionResult
-> [UpdatePersistentSubscriptionResult]
$cenumFromTo :: UpdatePersistentSubscriptionResult
-> UpdatePersistentSubscriptionResult
-> [UpdatePersistentSubscriptionResult]
enumFromThen :: UpdatePersistentSubscriptionResult
-> UpdatePersistentSubscriptionResult
-> [UpdatePersistentSubscriptionResult]
$cenumFromThen :: UpdatePersistentSubscriptionResult
-> UpdatePersistentSubscriptionResult
-> [UpdatePersistentSubscriptionResult]
enumFrom :: UpdatePersistentSubscriptionResult
-> [UpdatePersistentSubscriptionResult]
$cenumFrom :: UpdatePersistentSubscriptionResult
-> [UpdatePersistentSubscriptionResult]
fromEnum :: UpdatePersistentSubscriptionResult -> Int
$cfromEnum :: UpdatePersistentSubscriptionResult -> Int
toEnum :: Int -> UpdatePersistentSubscriptionResult
$ctoEnum :: Int -> UpdatePersistentSubscriptionResult
pred :: UpdatePersistentSubscriptionResult
-> UpdatePersistentSubscriptionResult
$cpred :: UpdatePersistentSubscriptionResult
-> UpdatePersistentSubscriptionResult
succ :: UpdatePersistentSubscriptionResult
-> UpdatePersistentSubscriptionResult
$csucc :: UpdatePersistentSubscriptionResult
-> UpdatePersistentSubscriptionResult
Enum, UpdatePersistentSubscriptionResult
-> UpdatePersistentSubscriptionResult -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UpdatePersistentSubscriptionResult
-> UpdatePersistentSubscriptionResult -> Bool
$c/= :: UpdatePersistentSubscriptionResult
-> UpdatePersistentSubscriptionResult -> Bool
== :: UpdatePersistentSubscriptionResult
-> UpdatePersistentSubscriptionResult -> Bool
$c== :: UpdatePersistentSubscriptionResult
-> UpdatePersistentSubscriptionResult -> Bool
Eq, Int -> UpdatePersistentSubscriptionResult -> ShowS
[UpdatePersistentSubscriptionResult] -> ShowS
UpdatePersistentSubscriptionResult -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UpdatePersistentSubscriptionResult] -> ShowS
$cshowList :: [UpdatePersistentSubscriptionResult] -> ShowS
show :: UpdatePersistentSubscriptionResult -> String
$cshow :: UpdatePersistentSubscriptionResult -> String
showsPrec :: Int -> UpdatePersistentSubscriptionResult -> ShowS
$cshowsPrec :: Int -> UpdatePersistentSubscriptionResult -> ShowS
Show)

--------------------------------------------------------------------------------
-- | Update persistent subscription response.
data UpdatePersistentSubscriptionCompleted =
    UpdatePersistentSubscriptionCompleted
    { UpdatePersistentSubscriptionCompleted
-> Required 1 (Enumeration UpdatePersistentSubscriptionResult)
upscResult :: Required 1 (Enumeration UpdatePersistentSubscriptionResult)
    , UpdatePersistentSubscriptionCompleted -> Optional 2 (Value Text)
upscReason :: Optional 2 (Value Text)
    } deriving (forall x.
Rep UpdatePersistentSubscriptionCompleted x
-> UpdatePersistentSubscriptionCompleted
forall x.
UpdatePersistentSubscriptionCompleted
-> Rep UpdatePersistentSubscriptionCompleted x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep UpdatePersistentSubscriptionCompleted x
-> UpdatePersistentSubscriptionCompleted
$cfrom :: forall x.
UpdatePersistentSubscriptionCompleted
-> Rep UpdatePersistentSubscriptionCompleted x
Generic, Int -> UpdatePersistentSubscriptionCompleted -> ShowS
[UpdatePersistentSubscriptionCompleted] -> ShowS
UpdatePersistentSubscriptionCompleted -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UpdatePersistentSubscriptionCompleted] -> ShowS
$cshowList :: [UpdatePersistentSubscriptionCompleted] -> ShowS
show :: UpdatePersistentSubscriptionCompleted -> String
$cshow :: UpdatePersistentSubscriptionCompleted -> String
showsPrec :: Int -> UpdatePersistentSubscriptionCompleted -> ShowS
$cshowsPrec :: Int -> UpdatePersistentSubscriptionCompleted -> ShowS
Show)

--------------------------------------------------------------------------------
instance Decode UpdatePersistentSubscriptionCompleted

--------------------------------------------------------------------------------
-- | Connect to a persistent subscription request.
data ConnectToPersistentSubscription =
    ConnectToPersistentSubscription
    { ConnectToPersistentSubscription -> Required 1 (Value Text)
ctsId                  :: Required 1 (Value Text)
    , ConnectToPersistentSubscription -> Required 2 (Value Text)
ctsStreamId            :: Required 2 (Value Text)
    , ConnectToPersistentSubscription -> Required 3 (Value Int32)
ctsAllowedInFlightMsgs :: Required 3 (Value Int32)
    } deriving (forall x.
Rep ConnectToPersistentSubscription x
-> ConnectToPersistentSubscription
forall x.
ConnectToPersistentSubscription
-> Rep ConnectToPersistentSubscription x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep ConnectToPersistentSubscription x
-> ConnectToPersistentSubscription
$cfrom :: forall x.
ConnectToPersistentSubscription
-> Rep ConnectToPersistentSubscription x
Generic, Int -> ConnectToPersistentSubscription -> ShowS
[ConnectToPersistentSubscription] -> ShowS
ConnectToPersistentSubscription -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ConnectToPersistentSubscription] -> ShowS
$cshowList :: [ConnectToPersistentSubscription] -> ShowS
show :: ConnectToPersistentSubscription -> String
$cshow :: ConnectToPersistentSubscription -> String
showsPrec :: Int -> ConnectToPersistentSubscription -> ShowS
$cshowsPrec :: Int -> ConnectToPersistentSubscription -> ShowS
Show)

--------------------------------------------------------------------------------
instance Encode ConnectToPersistentSubscription

--------------------------------------------------------------------------------
-- | 'ConnectToPersistentSubscription' smart constructor.
_connectToPersistentSubscription :: Text
                                 -> Text
                                 -> Int32
                                 -> ConnectToPersistentSubscription
_connectToPersistentSubscription :: Text -> Text -> Int32 -> ConnectToPersistentSubscription
_connectToPersistentSubscription Text
sub_id Text
stream_id Int32
all_fly_msgs =
    ConnectToPersistentSubscription
    { ctsId :: Required 1 (Value Text)
ctsId                  = forall a. HasField a => FieldType a -> a
putField Text
sub_id
    , ctsStreamId :: Required 2 (Value Text)
ctsStreamId            = forall a. HasField a => FieldType a -> a
putField Text
stream_id
    , ctsAllowedInFlightMsgs :: Required 3 (Value Int32)
ctsAllowedInFlightMsgs = forall a. HasField a => FieldType a -> a
putField Int32
all_fly_msgs
    }

--------------------------------------------------------------------------------
-- | Ack processed events request.
data PersistentSubscriptionAckEvents =
    PersistentSubscriptionAckEvents
    { PersistentSubscriptionAckEvents -> Required 1 (Value Text)
psaeId              :: Required 1 (Value Text)
    , PersistentSubscriptionAckEvents -> Repeated 2 (Value ByteString)
psaeProcessedEvtIds :: Repeated 2 (Value ByteString)
    } deriving (forall x.
Rep PersistentSubscriptionAckEvents x
-> PersistentSubscriptionAckEvents
forall x.
PersistentSubscriptionAckEvents
-> Rep PersistentSubscriptionAckEvents x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep PersistentSubscriptionAckEvents x
-> PersistentSubscriptionAckEvents
$cfrom :: forall x.
PersistentSubscriptionAckEvents
-> Rep PersistentSubscriptionAckEvents x
Generic, Int -> PersistentSubscriptionAckEvents -> ShowS
[PersistentSubscriptionAckEvents] -> ShowS
PersistentSubscriptionAckEvents -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PersistentSubscriptionAckEvents] -> ShowS
$cshowList :: [PersistentSubscriptionAckEvents] -> ShowS
show :: PersistentSubscriptionAckEvents -> String
$cshow :: PersistentSubscriptionAckEvents -> String
showsPrec :: Int -> PersistentSubscriptionAckEvents -> ShowS
$cshowsPrec :: Int -> PersistentSubscriptionAckEvents -> ShowS
Show)

--------------------------------------------------------------------------------
instance Encode PersistentSubscriptionAckEvents

--------------------------------------------------------------------------------
-- | 'PersistentSubscriptionAckEvents' smart constructor.
persistentSubscriptionAckEvents :: Text
                                -> [ByteString]
                                -> PersistentSubscriptionAckEvents
persistentSubscriptionAckEvents :: Text -> [ByteString] -> PersistentSubscriptionAckEvents
persistentSubscriptionAckEvents Text
sub_id [ByteString]
evt_ids =
    PersistentSubscriptionAckEvents
    { psaeId :: Required 1 (Value Text)
psaeId              = forall a. HasField a => FieldType a -> a
putField Text
sub_id
    , psaeProcessedEvtIds :: Repeated 2 (Value ByteString)
psaeProcessedEvtIds = forall a. HasField a => FieldType a -> a
putField [ByteString]
evt_ids
    }

--------------------------------------------------------------------------------
-- | Gathers every possible Nak actions.
data NakAction
    = NA_Unknown
    | NA_Park
    | NA_Retry
    | NA_Skip
    | NA_Stop
    deriving (Int -> NakAction
NakAction -> Int
NakAction -> [NakAction]
NakAction -> NakAction
NakAction -> NakAction -> [NakAction]
NakAction -> NakAction -> NakAction -> [NakAction]
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 :: NakAction -> NakAction -> NakAction -> [NakAction]
$cenumFromThenTo :: NakAction -> NakAction -> NakAction -> [NakAction]
enumFromTo :: NakAction -> NakAction -> [NakAction]
$cenumFromTo :: NakAction -> NakAction -> [NakAction]
enumFromThen :: NakAction -> NakAction -> [NakAction]
$cenumFromThen :: NakAction -> NakAction -> [NakAction]
enumFrom :: NakAction -> [NakAction]
$cenumFrom :: NakAction -> [NakAction]
fromEnum :: NakAction -> Int
$cfromEnum :: NakAction -> Int
toEnum :: Int -> NakAction
$ctoEnum :: Int -> NakAction
pred :: NakAction -> NakAction
$cpred :: NakAction -> NakAction
succ :: NakAction -> NakAction
$csucc :: NakAction -> NakAction
Enum, NakAction -> NakAction -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: NakAction -> NakAction -> Bool
$c/= :: NakAction -> NakAction -> Bool
== :: NakAction -> NakAction -> Bool
$c== :: NakAction -> NakAction -> Bool
Eq, Int -> NakAction -> ShowS
[NakAction] -> ShowS
NakAction -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [NakAction] -> ShowS
$cshowList :: [NakAction] -> ShowS
show :: NakAction -> String
$cshow :: NakAction -> String
showsPrec :: Int -> NakAction -> ShowS
$cshowsPrec :: Int -> NakAction -> ShowS
Show)

--------------------------------------------------------------------------------
-- | Nak processed events request.
data PersistentSubscriptionNakEvents =
    PersistentSubscriptionNakEvents
    { PersistentSubscriptionNakEvents -> Required 1 (Value Text)
psneId              :: Required 1 (Value Text)
    , PersistentSubscriptionNakEvents -> Repeated 2 (Value ByteString)
psneProcessedEvtIds :: Repeated 2 (Value ByteString)
    , PersistentSubscriptionNakEvents -> Optional 3 (Value Text)
psneMsg             :: Optional 3 (Value Text)
    , PersistentSubscriptionNakEvents
-> Required 4 (Enumeration NakAction)
psneAction          :: Required 4 (Enumeration NakAction)
    } deriving (forall x.
Rep PersistentSubscriptionNakEvents x
-> PersistentSubscriptionNakEvents
forall x.
PersistentSubscriptionNakEvents
-> Rep PersistentSubscriptionNakEvents x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep PersistentSubscriptionNakEvents x
-> PersistentSubscriptionNakEvents
$cfrom :: forall x.
PersistentSubscriptionNakEvents
-> Rep PersistentSubscriptionNakEvents x
Generic, Int -> PersistentSubscriptionNakEvents -> ShowS
[PersistentSubscriptionNakEvents] -> ShowS
PersistentSubscriptionNakEvents -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PersistentSubscriptionNakEvents] -> ShowS
$cshowList :: [PersistentSubscriptionNakEvents] -> ShowS
show :: PersistentSubscriptionNakEvents -> String
$cshow :: PersistentSubscriptionNakEvents -> String
showsPrec :: Int -> PersistentSubscriptionNakEvents -> ShowS
$cshowsPrec :: Int -> PersistentSubscriptionNakEvents -> ShowS
Show)

--------------------------------------------------------------------------------
instance Encode PersistentSubscriptionNakEvents

--------------------------------------------------------------------------------
-- | 'PersistentSubscriptionNakEvents' smart constructor.
persistentSubscriptionNakEvents :: Text
                                -> [ByteString]
                                -> Maybe Text
                                -> NakAction
                                -> PersistentSubscriptionNakEvents
persistentSubscriptionNakEvents :: Text
-> [ByteString]
-> Maybe Text
-> NakAction
-> PersistentSubscriptionNakEvents
persistentSubscriptionNakEvents Text
sub_id [ByteString]
evt_ids Maybe Text
msg NakAction
action =
    PersistentSubscriptionNakEvents
    { psneId :: Required 1 (Value Text)
psneId              = forall a. HasField a => FieldType a -> a
putField Text
sub_id
    , psneProcessedEvtIds :: Repeated 2 (Value ByteString)
psneProcessedEvtIds = forall a. HasField a => FieldType a -> a
putField [ByteString]
evt_ids
    , psneMsg :: Optional 3 (Value Text)
psneMsg             = forall a. HasField a => FieldType a -> a
putField Maybe Text
msg
    , psneAction :: Required 4 (Enumeration NakAction)
psneAction          = forall a. HasField a => FieldType a -> a
putField NakAction
action
    }

--------------------------------------------------------------------------------
-- | Connection to persistent subscription response.
data PersistentSubscriptionConfirmation =
    PersistentSubscriptionConfirmation
    { PersistentSubscriptionConfirmation -> Required 1 (Value Int64)
pscLastCommitPos :: Required 1 (Value Int64)
    , PersistentSubscriptionConfirmation -> Required 2 (Value Text)
pscId            :: Required 2 (Value Text)
    , PersistentSubscriptionConfirmation -> Optional 3 (Value Int64)
pscLastEvtNumber :: Optional 3 (Value Int64)
    } deriving (forall x.
Rep PersistentSubscriptionConfirmation x
-> PersistentSubscriptionConfirmation
forall x.
PersistentSubscriptionConfirmation
-> Rep PersistentSubscriptionConfirmation x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep PersistentSubscriptionConfirmation x
-> PersistentSubscriptionConfirmation
$cfrom :: forall x.
PersistentSubscriptionConfirmation
-> Rep PersistentSubscriptionConfirmation x
Generic, Int -> PersistentSubscriptionConfirmation -> ShowS
[PersistentSubscriptionConfirmation] -> ShowS
PersistentSubscriptionConfirmation -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PersistentSubscriptionConfirmation] -> ShowS
$cshowList :: [PersistentSubscriptionConfirmation] -> ShowS
show :: PersistentSubscriptionConfirmation -> String
$cshow :: PersistentSubscriptionConfirmation -> String
showsPrec :: Int -> PersistentSubscriptionConfirmation -> ShowS
$cshowsPrec :: Int -> PersistentSubscriptionConfirmation -> ShowS
Show)

--------------------------------------------------------------------------------
instance Decode PersistentSubscriptionConfirmation

--------------------------------------------------------------------------------
-- | Avalaible event sent by the server in the context of a persistent
--   subscription..
data PersistentSubscriptionStreamEventAppeared =
    PersistentSubscriptionStreamEventAppeared
    { PersistentSubscriptionStreamEventAppeared
-> Required 1 (Message ResolvedIndexedEvent)
psseaEvt :: Required 1 (Message ResolvedIndexedEvent) }
    deriving (forall x.
Rep PersistentSubscriptionStreamEventAppeared x
-> PersistentSubscriptionStreamEventAppeared
forall x.
PersistentSubscriptionStreamEventAppeared
-> Rep PersistentSubscriptionStreamEventAppeared x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep PersistentSubscriptionStreamEventAppeared x
-> PersistentSubscriptionStreamEventAppeared
$cfrom :: forall x.
PersistentSubscriptionStreamEventAppeared
-> Rep PersistentSubscriptionStreamEventAppeared x
Generic, Int -> PersistentSubscriptionStreamEventAppeared -> ShowS
[PersistentSubscriptionStreamEventAppeared] -> ShowS
PersistentSubscriptionStreamEventAppeared -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PersistentSubscriptionStreamEventAppeared] -> ShowS
$cshowList :: [PersistentSubscriptionStreamEventAppeared] -> ShowS
show :: PersistentSubscriptionStreamEventAppeared -> String
$cshow :: PersistentSubscriptionStreamEventAppeared -> String
showsPrec :: Int -> PersistentSubscriptionStreamEventAppeared -> ShowS
$cshowsPrec :: Int -> PersistentSubscriptionStreamEventAppeared -> ShowS
Show)

--------------------------------------------------------------------------------
instance Decode PersistentSubscriptionStreamEventAppeared