{-# LANGUAGE DeriveDataTypeable         #-}
{-# LANGUAGE DeriveGeneric              #-}
{-# LANGUAGE DataKinds                  #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE OverloadedStrings          #-}
{-# LANGUAGE RecordWildCards            #-}
{-# LANGUAGE ScopedTypeVariables        #-}
{-# LANGUAGE StrictData                 #-}
{-# LANGUAGE UndecidableInstances       #-}
--------------------------------------------------------------------------------
-- |
-- Module : Database.EventStore.Internal.Types
-- Copyright : (C) 2014 Yorick Laupa
-- License : (see the file LICENSE)
--
-- Maintainer : Yorick Laupa <yo.eight@gmail.com>
-- Stability : provisional
-- Portability : non-portable
--
--------------------------------------------------------------------------------
module Database.EventStore.Internal.Types where

--------------------------------------------------------------------------------
import Prelude (String)
import Data.Maybe
import Data.Monoid (Endo(..))
import Foreign.C.Types (CTime(..))
import Numeric.Natural (Natural)

--------------------------------------------------------------------------------
import           Control.Monad.Reader
import qualified Data.Aeson as A
import           Data.Aeson.Types (Object, ToJSON(..), Pair, Parser, (.=))
import qualified Data.Aeson.KeyMap as KeyMap
import           Data.DotNet.TimeSpan
import           Data.ProtocolBuffers
import           Data.Time (NominalDiffTime)
import           Data.Time.Clock.POSIX
import           Data.UUID (UUID, fromByteString, toByteString)
import qualified Data.Vector as Vector

--------------------------------------------------------------------------------
import Database.EventStore.Internal.Command
import Database.EventStore.Internal.EndPoint
import Database.EventStore.Internal.Prelude
import Database.EventStore.Internal.Settings

--------------------------------------------------------------------------------
-- Exceptions
--------------------------------------------------------------------------------
-- | Represent a class of error where the user is not at fault. It could be
--   either the client or the server.
data InternalException
    = ConnectionClosedByServer
      -- ^ Happens when the server deliberately close the connection. This
      --   probably happens if the client didn't respect EventStore
      --   communication error. For instance, the client takes too much time to
      --   respond to a heartbeat request.
    deriving (Int -> InternalException -> ShowS
[InternalException] -> ShowS
InternalException -> String
(Int -> InternalException -> ShowS)
-> (InternalException -> String)
-> ([InternalException] -> ShowS)
-> Show InternalException
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [InternalException] -> ShowS
$cshowList :: [InternalException] -> ShowS
show :: InternalException -> String
$cshow :: InternalException -> String
showsPrec :: Int -> InternalException -> ShowS
$cshowsPrec :: Int -> InternalException -> ShowS
Show, Typeable)

--------------------------------------------------------------------------------
instance Exception InternalException

--------------------------------------------------------------------------------
-- Event
--------------------------------------------------------------------------------
-- | Constants for System event types.
data EventType
    = StreamDeletedType
      -- ^ Event type for stream deleted.
    | StatsCollectionType
      -- ^ Event type for statistics.
    | LinkToType
      -- ^ Event type for linkTo.
    | StreamMetadataType
      -- ^ Event type for stream metadata.
    | SettingsType
      -- ^ Event type for the system settings.
    | UserDefined Text
      -- ^ Event defined by the user.
    deriving EventType -> EventType -> Bool
(EventType -> EventType -> Bool)
-> (EventType -> EventType -> Bool) -> Eq EventType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: EventType -> EventType -> Bool
$c/= :: EventType -> EventType -> Bool
== :: EventType -> EventType -> Bool
$c== :: EventType -> EventType -> Bool
Eq

--------------------------------------------------------------------------------
instance IsString EventType where
    fromString :: String -> EventType
fromString = String -> EventType
eventTypeFromStr

--------------------------------------------------------------------------------
instance Show EventType where
    show :: EventType -> String
show = Text -> String
forall mono. MonoFoldable mono => mono -> [Element mono]
unpack (Text -> String) -> (EventType -> Text) -> EventType -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EventType -> Text
eventTypeText

--------------------------------------------------------------------------------
eventTypeText :: EventType -> Text
eventTypeText :: EventType -> Text
eventTypeText EventType
StreamDeletedType = Text
"$streamDeleted"
eventTypeText EventType
StatsCollectionType = Text
"$statsCollected"
eventTypeText EventType
LinkToType = Text
"$>"
eventTypeText EventType
StreamMetadataType = Text
"$metadata"
eventTypeText EventType
SettingsType = Text
"$settings"
eventTypeText (UserDefined Text
t) = Text
t

--------------------------------------------------------------------------------
eventTypeFromStr :: String -> EventType
eventTypeFromStr :: String -> EventType
eventTypeFromStr String
"$streamDeleted" = EventType
StreamDeletedType
eventTypeFromStr String
"$statsCollected" = EventType
StatsCollectionType
eventTypeFromStr String
"$>" = EventType
LinkToType
eventTypeFromStr String
"$metadata" = EventType
StreamMetadataType
eventTypeFromStr String
"$settings" = EventType
SettingsType
eventTypeFromStr String
t = Text -> EventType
UserDefined (Text -> EventType) -> Text -> EventType
forall a b. (a -> b) -> a -> b
$ [Element Text] -> Text
forall seq. IsSequence seq => [Element seq] -> seq
pack String
[Element Text]
t

--------------------------------------------------------------------------------
-- | Contains event information like its type and data. Only used for write
--   queries.
data Event
    = Event
      { Event -> EventType
eventType :: !EventType
      , Event -> Maybe UUID
eventId   :: !(Maybe UUID)
      , Event -> EventData
eventData :: !EventData
      } deriving (Event -> Event -> Bool
(Event -> Event -> Bool) -> (Event -> Event -> Bool) -> Eq Event
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Event -> Event -> Bool
$c/= :: Event -> Event -> Bool
== :: Event -> Event -> Bool
$c== :: Event -> Event -> Bool
Eq, Int -> Event -> ShowS
[Event] -> ShowS
Event -> String
(Int -> Event -> ShowS)
-> (Event -> String) -> ([Event] -> ShowS) -> Show Event
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Event] -> ShowS
$cshowList :: [Event] -> ShowS
show :: Event -> String
$cshow :: Event -> String
showsPrec :: Int -> Event -> ShowS
$cshowsPrec :: Int -> Event -> ShowS
Show)

--------------------------------------------------------------------------------
-- | Create an 'Event' meant to be persisted.
createEvent :: EventType  -- ^ Event type
            -> Maybe UUID -- ^ Event ID, generated if 'Nothing'
            -> EventData  -- ^ Event data
            -> Event
createEvent :: EventType -> Maybe UUID -> EventData -> Event
createEvent = EventType -> Maybe UUID -> EventData -> Event
Event

--------------------------------------------------------------------------------
-- | Holds event data.
data EventData
    = Json A.Value (Maybe A.Value)
    | Binary ByteString (Maybe ByteString)
    deriving (EventData -> EventData -> Bool
(EventData -> EventData -> Bool)
-> (EventData -> EventData -> Bool) -> Eq EventData
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: EventData -> EventData -> Bool
$c/= :: EventData -> EventData -> Bool
== :: EventData -> EventData -> Bool
$c== :: EventData -> EventData -> Bool
Eq, Int -> EventData -> ShowS
[EventData] -> ShowS
EventData -> String
(Int -> EventData -> ShowS)
-> (EventData -> String)
-> ([EventData] -> ShowS)
-> Show EventData
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [EventData] -> ShowS
$cshowList :: [EventData] -> ShowS
show :: EventData -> String
$cshow :: EventData -> String
showsPrec :: Int -> EventData -> ShowS
$cshowsPrec :: Int -> EventData -> ShowS
Show)

--------------------------------------------------------------------------------
-- | Maps 'Event' inner data type to an 'Int32' understandable by the server.
eventDataType :: EventData -> Int32
eventDataType :: EventData -> Int32
eventDataType (Json Value
_ Maybe Value
_) = Int32
1
eventDataType EventData
_          = Int32
0

--------------------------------------------------------------------------------
-- | Maps 'Event' inner metadata type to an 'Int32' understandable by the
--   server.
eventMetadataType :: EventData -> Int32
eventMetadataType :: EventData -> Int32
eventMetadataType EventData
_ = Int32
0

--------------------------------------------------------------------------------
-- | Creates an event using JSON format
withJson :: ToJSON a => a -> EventData
withJson :: a -> EventData
withJson a
value = Value -> Maybe Value -> EventData
Json (a -> Value
forall a. ToJSON a => a -> Value
toJSON a
value) Maybe Value
forall a. Maybe a
Nothing

--------------------------------------------------------------------------------
-- | Creates an event using a binary format.
withBinary :: ByteString -> EventData
withBinary :: ByteString -> EventData
withBinary ByteString
bs = ByteString -> Maybe ByteString -> EventData
Binary ByteString
bs Maybe ByteString
forall a. Maybe a
Nothing

--------------------------------------------------------------------------------
-- | Creates an event with metadata using JSON format.
withJsonAndMetadata :: (ToJSON a, ToJSON b) => a -> b -> EventData
withJsonAndMetadata :: a -> b -> EventData
withJsonAndMetadata a
value b
metadata =
    Value -> Maybe Value -> EventData
Json (a -> Value
forall a. ToJSON a => a -> Value
toJSON a
value) (Value -> Maybe Value
forall a. a -> Maybe a
Just (Value -> Maybe Value) -> Value -> Maybe Value
forall a b. (a -> b) -> a -> b
$ b -> Value
forall a. ToJSON a => a -> Value
toJSON b
metadata)

--------------------------------------------------------------------------------
-- | Creates an event with metadata using binary format.
withBinaryAndMetadata :: ByteString -> ByteString -> EventData
withBinaryAndMetadata :: ByteString -> ByteString -> EventData
withBinaryAndMetadata ByteString
value ByteString
metadata = ByteString -> Maybe ByteString -> EventData
Binary ByteString
value (ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just ByteString
metadata)

--------------------------------------------------------------------------------
-- | Serializes 'EventData''s data to a raw 'ByteString'.
eventDataBytes :: EventData -> ByteString
eventDataBytes :: EventData -> ByteString
eventDataBytes (Json Value
value Maybe Value
_)   = ByteString -> ByteString
forall lazy strict. LazySequence lazy strict => lazy -> strict
toStrict (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ Value -> ByteString
forall a. ToJSON a => a -> ByteString
A.encode Value
value
eventDataBytes (Binary ByteString
value Maybe ByteString
_) = ByteString
value

--------------------------------------------------------------------------------
-- | Serializes 'EventData' metadata to a raw 'ByteString'.
eventMetadataBytes :: EventData -> Maybe ByteString
eventMetadataBytes :: EventData -> Maybe ByteString
eventMetadataBytes (Json Value
_ Maybe Value
meta_m)   = (Value -> ByteString) -> Maybe Value -> Maybe ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (ByteString -> ByteString
forall lazy strict. LazySequence lazy strict => lazy -> strict
toStrict (ByteString -> ByteString)
-> (Value -> ByteString) -> Value -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value -> ByteString
forall a. ToJSON a => a -> ByteString
A.encode) Maybe Value
meta_m
eventMetadataBytes (Binary ByteString
_ Maybe ByteString
meta_m) = Maybe ByteString
meta_m

--------------------------------------------------------------------------------
-- Expected Version
--------------------------------------------------------------------------------
-- | Constants used for expected version control.
--
--   The use of expected version can be a bit tricky especially when discussing
--   idempotency assurances given by the EventStore.
--
--   The EventStore  will assure idempotency for all operations using any value
--   in 'ExpectedVersion' except for 'anyStream'. When using 'anyStream' the
--   EventStore will do its best to assure idempotency but will not guarantee
--   idempotency.
data ExpectedVersion
    = Any
    | NoStream
    | EmptyStream
    | Exact Int64
    | StreamExists
    deriving (ExpectedVersion -> ExpectedVersion -> Bool
(ExpectedVersion -> ExpectedVersion -> Bool)
-> (ExpectedVersion -> ExpectedVersion -> Bool)
-> Eq ExpectedVersion
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ExpectedVersion -> ExpectedVersion -> Bool
$c/= :: ExpectedVersion -> ExpectedVersion -> Bool
== :: ExpectedVersion -> ExpectedVersion -> Bool
$c== :: ExpectedVersion -> ExpectedVersion -> Bool
Eq, Int -> ExpectedVersion -> ShowS
[ExpectedVersion] -> ShowS
ExpectedVersion -> String
(Int -> ExpectedVersion -> ShowS)
-> (ExpectedVersion -> String)
-> ([ExpectedVersion] -> ShowS)
-> Show ExpectedVersion
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ExpectedVersion] -> ShowS
$cshowList :: [ExpectedVersion] -> ShowS
show :: ExpectedVersion -> String
$cshow :: ExpectedVersion -> String
showsPrec :: Int -> ExpectedVersion -> ShowS
$cshowsPrec :: Int -> ExpectedVersion -> ShowS
Show)

--------------------------------------------------------------------------------
-- | Maps a 'ExpectedVersion' to an 'Int32' understandable by the server.
expVersionInt64 :: ExpectedVersion -> Int64
expVersionInt64 :: ExpectedVersion -> Int64
expVersionInt64 ExpectedVersion
Any         = -Int64
2
expVersionInt64 ExpectedVersion
NoStream    = -Int64
1
expVersionInt64 ExpectedVersion
EmptyStream = -Int64
1
expVersionInt64 (Exact Int64
n)   = Int64
n
expVersionInt64 ExpectedVersion
StreamExists = -Int64
4

--------------------------------------------------------------------------------
-- | This write should not conflict with anything and should always succeed.
anyVersion :: ExpectedVersion
anyVersion :: ExpectedVersion
anyVersion = ExpectedVersion
Any

--------------------------------------------------------------------------------
-- | The stream being written to should not yet exist. If it does exist
--   treat that as a concurrency problem.
noStreamVersion :: ExpectedVersion
noStreamVersion :: ExpectedVersion
noStreamVersion = ExpectedVersion
NoStream

--------------------------------------------------------------------------------
-- | The stream should exist and should be empty. If it does not exist or
--   is not empty, treat that as a concurrency problem.
emptyStreamVersion :: ExpectedVersion
emptyStreamVersion :: ExpectedVersion
emptyStreamVersion = ExpectedVersion
EmptyStream

--------------------------------------------------------------------------------
-- | States that the last event written to the stream should have a
--   sequence number matching your expected value.
exactEventVersion :: Int64 -> ExpectedVersion
exactEventVersion :: Int64 -> ExpectedVersion
exactEventVersion Int64
n
    | Int64
n Int64 -> Int64 -> Bool
forall a. Ord a => a -> a -> Bool
< Int64
0     = String -> ExpectedVersion
forall a. HasCallStack => String -> a
error (String -> ExpectedVersion) -> String -> ExpectedVersion
forall a b. (a -> b) -> a -> b
$ String
"expected version must be >= 0, but is " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Int64 -> String
forall a. Show a => a -> String
show Int64
n
    | Bool
otherwise = Int64 -> ExpectedVersion
Exact Int64
n

--------------------------------------------------------------------------------
-- | The stream should exist. If it or a metadata stream does not exist treat
--   that as a concurrency problem.
streamExists :: ExpectedVersion
streamExists :: ExpectedVersion
streamExists = ExpectedVersion
StreamExists

--------------------------------------------------------------------------------
-- | Represents an event position within a stream.
newtype EventNumber = EventNumber Int64 deriving (EventNumber -> EventNumber -> Bool
(EventNumber -> EventNumber -> Bool)
-> (EventNumber -> EventNumber -> Bool) -> Eq EventNumber
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: EventNumber -> EventNumber -> Bool
$c/= :: EventNumber -> EventNumber -> Bool
== :: EventNumber -> EventNumber -> Bool
$c== :: EventNumber -> EventNumber -> Bool
Eq, Eq EventNumber
Eq EventNumber
-> (EventNumber -> EventNumber -> Ordering)
-> (EventNumber -> EventNumber -> Bool)
-> (EventNumber -> EventNumber -> Bool)
-> (EventNumber -> EventNumber -> Bool)
-> (EventNumber -> EventNumber -> Bool)
-> (EventNumber -> EventNumber -> EventNumber)
-> (EventNumber -> EventNumber -> EventNumber)
-> Ord EventNumber
EventNumber -> EventNumber -> Bool
EventNumber -> EventNumber -> Ordering
EventNumber -> EventNumber -> EventNumber
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: EventNumber -> EventNumber -> EventNumber
$cmin :: EventNumber -> EventNumber -> EventNumber
max :: EventNumber -> EventNumber -> EventNumber
$cmax :: EventNumber -> EventNumber -> EventNumber
>= :: EventNumber -> EventNumber -> Bool
$c>= :: EventNumber -> EventNumber -> Bool
> :: EventNumber -> EventNumber -> Bool
$c> :: EventNumber -> EventNumber -> Bool
<= :: EventNumber -> EventNumber -> Bool
$c<= :: EventNumber -> EventNumber -> Bool
< :: EventNumber -> EventNumber -> Bool
$c< :: EventNumber -> EventNumber -> Bool
compare :: EventNumber -> EventNumber -> Ordering
$ccompare :: EventNumber -> EventNumber -> Ordering
$cp1Ord :: Eq EventNumber
Ord, Int -> EventNumber -> ShowS
[EventNumber] -> ShowS
EventNumber -> String
(Int -> EventNumber -> ShowS)
-> (EventNumber -> String)
-> ([EventNumber] -> ShowS)
-> Show EventNumber
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [EventNumber] -> ShowS
$cshowList :: [EventNumber] -> ShowS
show :: EventNumber -> String
$cshow :: EventNumber -> String
showsPrec :: Int -> EventNumber -> ShowS
$cshowsPrec :: Int -> EventNumber -> ShowS
Show)

--------------------------------------------------------------------------------
-- | The first event in a stream.
streamStart :: EventNumber
streamStart :: EventNumber
streamStart = Int64 -> EventNumber
EventNumber Int64
0

--------------------------------------------------------------------------------
-- | The last event in the stream.
streamEnd :: EventNumber
streamEnd :: EventNumber
streamEnd = Int64 -> EventNumber
EventNumber (-Int64
1)

--------------------------------------------------------------------------------
-- | the Nth event of a stream.
eventNumber :: Natural -> EventNumber
eventNumber :: Natural -> EventNumber
eventNumber Natural
n = Int64 -> EventNumber
EventNumber (Natural -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Natural
n)

--------------------------------------------------------------------------------
-- | Returns a 'EventNumber from a raw 'Int64'.
rawEventNumber :: Int64 -> EventNumber
rawEventNumber :: Int64 -> EventNumber
rawEventNumber = Int64 -> EventNumber
EventNumber

--------------------------------------------------------------------------------
-- | Returns a raw 'Int64' from an 'EventNumber'.
eventNumberToInt64 :: EventNumber -> Int64
eventNumberToInt64 :: EventNumber -> Int64
eventNumberToInt64 (EventNumber Int64
n) = Int64
n

--------------------------------------------------------------------------------
-- | Determines whether any link event encountered in the stream will be
--   resolved. See the discussion for more information:
--   https://eventstore.com/docs/dotnet-api/reading-events/index.html#resolvedevent
data ResolveLink = ResolveLink | NoResolveLink deriving (Int -> ResolveLink -> ShowS
[ResolveLink] -> ShowS
ResolveLink -> String
(Int -> ResolveLink -> ShowS)
-> (ResolveLink -> String)
-> ([ResolveLink] -> ShowS)
-> Show ResolveLink
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ResolveLink] -> ShowS
$cshowList :: [ResolveLink] -> ShowS
show :: ResolveLink -> String
$cshow :: ResolveLink -> String
showsPrec :: Int -> ResolveLink -> ShowS
$cshowsPrec :: Int -> ResolveLink -> ShowS
Show, ResolveLink -> ResolveLink -> Bool
(ResolveLink -> ResolveLink -> Bool)
-> (ResolveLink -> ResolveLink -> Bool) -> Eq ResolveLink
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ResolveLink -> ResolveLink -> Bool
$c/= :: ResolveLink -> ResolveLink -> Bool
== :: ResolveLink -> ResolveLink -> Bool
$c== :: ResolveLink -> ResolveLink -> Bool
Eq)

--------------------------------------------------------------------------------
resolveLinkToBool :: ResolveLink -> Bool
resolveLinkToBool :: ResolveLink -> Bool
resolveLinkToBool ResolveLink
ResolveLink   = Bool
True
resolveLinkToBool ResolveLink
NoResolveLink = Bool
False

--------------------------------------------------------------------------------
-- EventStore Messages
--------------------------------------------------------------------------------
-- | Serializes form of an 'Event'.
data NewEvent
    = NewEvent
      { NewEvent -> Required 1 (Value ByteString)
newEventId           :: Required 1 (Value ByteString)
      , NewEvent -> Required 2 (Value Text)
newEventType         :: Required 2 (Value Text)
      , NewEvent -> Required 3 (Value Int32)
newEventDataType     :: Required 3 (Value Int32)
      , NewEvent -> Required 4 (Value Int32)
newEventMetadataType :: Required 4 (Value Int32)
      , NewEvent -> Required 5 (Value ByteString)
newEventData         :: Required 5 (Value ByteString)
      , NewEvent -> Optional 6 (Value ByteString)
newEventMetadata     :: Optional 6 (Value ByteString)
      }
    deriving ((forall x. NewEvent -> Rep NewEvent x)
-> (forall x. Rep NewEvent x -> NewEvent) -> Generic NewEvent
forall x. Rep NewEvent x -> NewEvent
forall x. NewEvent -> Rep NewEvent x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep NewEvent x -> NewEvent
$cfrom :: forall x. NewEvent -> Rep NewEvent x
Generic, Int -> NewEvent -> ShowS
[NewEvent] -> ShowS
NewEvent -> String
(Int -> NewEvent -> ShowS)
-> (NewEvent -> String) -> ([NewEvent] -> ShowS) -> Show NewEvent
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [NewEvent] -> ShowS
$cshowList :: [NewEvent] -> ShowS
show :: NewEvent -> String
$cshow :: NewEvent -> String
showsPrec :: Int -> NewEvent -> ShowS
$cshowsPrec :: Int -> NewEvent -> ShowS
Show)

--------------------------------------------------------------------------------
instance Encode NewEvent

--------------------------------------------------------------------------------
-- | 'NewEvent' smart constructor.
newEvent :: Text             -- ^ Event type
         -> UUID             -- ^ Event ID
         -> Int32            -- ^ Data content type
         -> Int32            -- ^ Metadata content type
         -> ByteString       -- ^ Event data
         -> Maybe ByteString -- ^ Metadata
         -> NewEvent
newEvent :: Text
-> UUID
-> Int32
-> Int32
-> ByteString
-> Maybe ByteString
-> NewEvent
newEvent Text
evt_type UUID
evt_id Int32
data_type Int32
meta_type ByteString
evt_data Maybe ByteString
evt_meta =
    let uuid_bytes :: ByteString
uuid_bytes = ByteString -> ByteString
forall lazy strict. LazySequence lazy strict => lazy -> strict
toStrict (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ UUID -> ByteString
toByteString UUID
evt_id
        new_evt :: NewEvent
new_evt    = NewEvent :: Required 1 (Value ByteString)
-> Required 2 (Value Text)
-> Required 3 (Value Int32)
-> Required 4 (Value Int32)
-> Required 5 (Value ByteString)
-> Optional 6 (Value ByteString)
-> NewEvent
NewEvent
                     { newEventId :: Required 1 (Value ByteString)
newEventId           = FieldType (Field 1 (RequiredField (Always (Value ByteString))))
-> Field 1 (RequiredField (Always (Value ByteString)))
forall a. HasField a => FieldType a -> a
putField ByteString
FieldType (Field 1 (RequiredField (Always (Value ByteString))))
uuid_bytes
                     , newEventType :: Required 2 (Value Text)
newEventType         = FieldType (Field 2 (RequiredField (Always (Value Text))))
-> Field 2 (RequiredField (Always (Value Text)))
forall a. HasField a => FieldType a -> a
putField Text
FieldType (Field 2 (RequiredField (Always (Value Text))))
evt_type
                     , newEventDataType :: Required 3 (Value Int32)
newEventDataType     = 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))))
data_type
                     , newEventMetadataType :: Required 4 (Value Int32)
newEventMetadataType = FieldType (Field 4 (RequiredField (Always (Value Int32))))
-> Field 4 (RequiredField (Always (Value Int32)))
forall a. HasField a => FieldType a -> a
putField Int32
FieldType (Field 4 (RequiredField (Always (Value Int32))))
meta_type
                     , newEventData :: Required 5 (Value ByteString)
newEventData         = FieldType (Field 5 (RequiredField (Always (Value ByteString))))
-> Field 5 (RequiredField (Always (Value ByteString)))
forall a. HasField a => FieldType a -> a
putField ByteString
FieldType (Field 5 (RequiredField (Always (Value ByteString))))
evt_data
                     , newEventMetadata :: Optional 6 (Value ByteString)
newEventMetadata     = FieldType (Field 6 (OptionalField (Last (Value ByteString))))
-> Field 6 (OptionalField (Last (Value ByteString)))
forall a. HasField a => FieldType a -> a
putField Maybe ByteString
FieldType (Field 6 (OptionalField (Last (Value ByteString))))
evt_meta
                     } in
    NewEvent
new_evt

--------------------------------------------------------------------------------
-- | Represents a serialized event coming from the server.
data EventRecord
    = EventRecord
      { EventRecord -> Required 1 (Value Text)
eventRecordStreamId     :: Required 1  (Value Text)
      , EventRecord -> Required 2 (Value Int64)
eventRecordNumber       :: Required 2  (Value Int64)
      , EventRecord -> Required 3 (Value ByteString)
eventRecordId           :: Required 3  (Value ByteString)
      , EventRecord -> Required 4 (Value Text)
eventRecordType         :: Required 4  (Value Text)
      , EventRecord -> Required 5 (Value Int32)
eventRecordDataType     :: Required 5  (Value Int32)
      , EventRecord -> Required 6 (Value Int32)
eventRecordMetadataType :: Required 6  (Value Int32)
      , EventRecord -> Required 7 (Value ByteString)
eventRecordData         :: Required 7  (Value ByteString)
      , EventRecord -> Optional 8 (Value ByteString)
eventRecordMetadata     :: Optional 8  (Value ByteString)
      , EventRecord -> Optional 9 (Value Int64)
eventRecordCreated      :: Optional 9  (Value Int64)
      , EventRecord -> Optional 10 (Value Int64)
eventRecordCreatedEpoch :: Optional 10 (Value Int64)
      }
    deriving ((forall x. EventRecord -> Rep EventRecord x)
-> (forall x. Rep EventRecord x -> EventRecord)
-> Generic EventRecord
forall x. Rep EventRecord x -> EventRecord
forall x. EventRecord -> Rep EventRecord x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep EventRecord x -> EventRecord
$cfrom :: forall x. EventRecord -> Rep EventRecord x
Generic, Int -> EventRecord -> ShowS
[EventRecord] -> ShowS
EventRecord -> String
(Int -> EventRecord -> ShowS)
-> (EventRecord -> String)
-> ([EventRecord] -> ShowS)
-> Show EventRecord
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [EventRecord] -> ShowS
$cshowList :: [EventRecord] -> ShowS
show :: EventRecord -> String
$cshow :: EventRecord -> String
showsPrec :: Int -> EventRecord -> ShowS
$cshowsPrec :: Int -> EventRecord -> ShowS
Show)

--------------------------------------------------------------------------------
instance Decode EventRecord
instance Encode EventRecord

--------------------------------------------------------------------------------
-- | Represents a serialized event representiong either an event or a link
--   event.
data ResolvedIndexedEvent
    = ResolvedIndexedEvent
      { ResolvedIndexedEvent -> Optional 1 (Message EventRecord)
resolvedIndexedRecord :: Optional 1 (Message EventRecord)
      , ResolvedIndexedEvent -> Optional 2 (Message EventRecord)
resolvedIndexedLink   :: Optional 2 (Message EventRecord)
      }
    deriving ((forall x. ResolvedIndexedEvent -> Rep ResolvedIndexedEvent x)
-> (forall x. Rep ResolvedIndexedEvent x -> ResolvedIndexedEvent)
-> Generic ResolvedIndexedEvent
forall x. Rep ResolvedIndexedEvent x -> ResolvedIndexedEvent
forall x. ResolvedIndexedEvent -> Rep ResolvedIndexedEvent x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ResolvedIndexedEvent x -> ResolvedIndexedEvent
$cfrom :: forall x. ResolvedIndexedEvent -> Rep ResolvedIndexedEvent x
Generic, Int -> ResolvedIndexedEvent -> ShowS
[ResolvedIndexedEvent] -> ShowS
ResolvedIndexedEvent -> String
(Int -> ResolvedIndexedEvent -> ShowS)
-> (ResolvedIndexedEvent -> String)
-> ([ResolvedIndexedEvent] -> ShowS)
-> Show ResolvedIndexedEvent
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ResolvedIndexedEvent] -> ShowS
$cshowList :: [ResolvedIndexedEvent] -> ShowS
show :: ResolvedIndexedEvent -> String
$cshow :: ResolvedIndexedEvent -> String
showsPrec :: Int -> ResolvedIndexedEvent -> ShowS
$cshowsPrec :: Int -> ResolvedIndexedEvent -> ShowS
Show)

--------------------------------------------------------------------------------
instance Decode ResolvedIndexedEvent
instance Encode ResolvedIndexedEvent

--------------------------------------------------------------------------------
data NotHandledReason
    = N_NotReady
    | N_TooBusy
    | N_NotMaster
    deriving (Int -> NotHandledReason
NotHandledReason -> Int
NotHandledReason -> [NotHandledReason]
NotHandledReason -> NotHandledReason
NotHandledReason -> NotHandledReason -> [NotHandledReason]
NotHandledReason
-> NotHandledReason -> NotHandledReason -> [NotHandledReason]
(NotHandledReason -> NotHandledReason)
-> (NotHandledReason -> NotHandledReason)
-> (Int -> NotHandledReason)
-> (NotHandledReason -> Int)
-> (NotHandledReason -> [NotHandledReason])
-> (NotHandledReason -> NotHandledReason -> [NotHandledReason])
-> (NotHandledReason -> NotHandledReason -> [NotHandledReason])
-> (NotHandledReason
    -> NotHandledReason -> NotHandledReason -> [NotHandledReason])
-> Enum NotHandledReason
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 :: NotHandledReason
-> NotHandledReason -> NotHandledReason -> [NotHandledReason]
$cenumFromThenTo :: NotHandledReason
-> NotHandledReason -> NotHandledReason -> [NotHandledReason]
enumFromTo :: NotHandledReason -> NotHandledReason -> [NotHandledReason]
$cenumFromTo :: NotHandledReason -> NotHandledReason -> [NotHandledReason]
enumFromThen :: NotHandledReason -> NotHandledReason -> [NotHandledReason]
$cenumFromThen :: NotHandledReason -> NotHandledReason -> [NotHandledReason]
enumFrom :: NotHandledReason -> [NotHandledReason]
$cenumFrom :: NotHandledReason -> [NotHandledReason]
fromEnum :: NotHandledReason -> Int
$cfromEnum :: NotHandledReason -> Int
toEnum :: Int -> NotHandledReason
$ctoEnum :: Int -> NotHandledReason
pred :: NotHandledReason -> NotHandledReason
$cpred :: NotHandledReason -> NotHandledReason
succ :: NotHandledReason -> NotHandledReason
$csucc :: NotHandledReason -> NotHandledReason
Enum, NotHandledReason -> NotHandledReason -> Bool
(NotHandledReason -> NotHandledReason -> Bool)
-> (NotHandledReason -> NotHandledReason -> Bool)
-> Eq NotHandledReason
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: NotHandledReason -> NotHandledReason -> Bool
$c/= :: NotHandledReason -> NotHandledReason -> Bool
== :: NotHandledReason -> NotHandledReason -> Bool
$c== :: NotHandledReason -> NotHandledReason -> Bool
Eq, Int -> NotHandledReason -> ShowS
[NotHandledReason] -> ShowS
NotHandledReason -> String
(Int -> NotHandledReason -> ShowS)
-> (NotHandledReason -> String)
-> ([NotHandledReason] -> ShowS)
-> Show NotHandledReason
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [NotHandledReason] -> ShowS
$cshowList :: [NotHandledReason] -> ShowS
show :: NotHandledReason -> String
$cshow :: NotHandledReason -> String
showsPrec :: Int -> NotHandledReason -> ShowS
$cshowsPrec :: Int -> NotHandledReason -> ShowS
Show)

--------------------------------------------------------------------------------
data MasterInfoBuf
    = MasterInfoBuf
      { MasterInfoBuf -> Required 1 (Value Text)
bufMasterExternalTcpAddr :: Required 1 (Value Text)
      , MasterInfoBuf -> Required 2 (Value Int32)
bufMasterExternalTcpPort :: Required 2 (Value Int32)
      , MasterInfoBuf -> Required 3 (Value Text)
bufMasterExternalHttpAddr :: Required 3 (Value Text)
      , MasterInfoBuf -> Required 4 (Value Int32)
bufMasterExternalHttpPort :: Required 4 (Value Int32)
      , MasterInfoBuf -> Optional 5 (Value Text)
bufMasterExternalSecureTcpAddr :: Optional 5 (Value Text)
      , MasterInfoBuf -> Optional 6 (Value Int32)
bufMasterExternalSecureTcpPort :: Optional 6 (Value Int32)
      } deriving ((forall x. MasterInfoBuf -> Rep MasterInfoBuf x)
-> (forall x. Rep MasterInfoBuf x -> MasterInfoBuf)
-> Generic MasterInfoBuf
forall x. Rep MasterInfoBuf x -> MasterInfoBuf
forall x. MasterInfoBuf -> Rep MasterInfoBuf x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep MasterInfoBuf x -> MasterInfoBuf
$cfrom :: forall x. MasterInfoBuf -> Rep MasterInfoBuf x
Generic, Int -> MasterInfoBuf -> ShowS
[MasterInfoBuf] -> ShowS
MasterInfoBuf -> String
(Int -> MasterInfoBuf -> ShowS)
-> (MasterInfoBuf -> String)
-> ([MasterInfoBuf] -> ShowS)
-> Show MasterInfoBuf
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [MasterInfoBuf] -> ShowS
$cshowList :: [MasterInfoBuf] -> ShowS
show :: MasterInfoBuf -> String
$cshow :: MasterInfoBuf -> String
showsPrec :: Int -> MasterInfoBuf -> ShowS
$cshowsPrec :: Int -> MasterInfoBuf -> ShowS
Show)

--------------------------------------------------------------------------------
instance Decode MasterInfoBuf
-- For testing purpose.
instance Encode MasterInfoBuf

--------------------------------------------------------------------------------
data MasterInfo
    = MasterInfo
      { MasterInfo -> String
masterExternalTcpAddr :: !String
      , MasterInfo -> Int
masterExternalTcpPort :: !Int
      , MasterInfo -> String
masterExternalHttpAddr :: !String
      , MasterInfo -> Int
masterExternalHttpPort :: !Int
      , MasterInfo -> Maybe String
masterExternalSecureTcpAddr :: !(Maybe String)
      , MasterInfo -> Maybe Int
masterExternalSecureTcpPort :: !(Maybe Int)
      } deriving (Int -> MasterInfo -> ShowS
[MasterInfo] -> ShowS
MasterInfo -> String
(Int -> MasterInfo -> ShowS)
-> (MasterInfo -> String)
-> ([MasterInfo] -> ShowS)
-> Show MasterInfo
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [MasterInfo] -> ShowS
$cshowList :: [MasterInfo] -> ShowS
show :: MasterInfo -> String
$cshow :: MasterInfo -> String
showsPrec :: Int -> MasterInfo -> ShowS
$cshowsPrec :: Int -> MasterInfo -> ShowS
Show, MasterInfo -> MasterInfo -> Bool
(MasterInfo -> MasterInfo -> Bool)
-> (MasterInfo -> MasterInfo -> Bool) -> Eq MasterInfo
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MasterInfo -> MasterInfo -> Bool
$c/= :: MasterInfo -> MasterInfo -> Bool
== :: MasterInfo -> MasterInfo -> Bool
$c== :: MasterInfo -> MasterInfo -> Bool
Eq)

--------------------------------------------------------------------------------
masterInfo :: MasterInfoBuf -> MasterInfo
masterInfo :: MasterInfoBuf -> MasterInfo
masterInfo MasterInfoBuf
buf =
    MasterInfo :: String
-> Int -> String -> Int -> Maybe String -> Maybe Int -> MasterInfo
MasterInfo
    { masterExternalTcpAddr :: String
masterExternalTcpAddr =
          Text -> [Element Text]
forall mono. MonoFoldable mono => mono -> [Element mono]
unpack (Text -> [Element Text]) -> Text -> [Element Text]
forall a b. (a -> b) -> a -> b
$ Field 1 (RequiredField (Always (Value Text)))
-> FieldType (Field 1 (RequiredField (Always (Value Text))))
forall a. HasField a => a -> FieldType a
getField (Field 1 (RequiredField (Always (Value Text)))
 -> FieldType (Field 1 (RequiredField (Always (Value Text)))))
-> Field 1 (RequiredField (Always (Value Text)))
-> FieldType (Field 1 (RequiredField (Always (Value Text))))
forall a b. (a -> b) -> a -> b
$ MasterInfoBuf -> Required 1 (Value Text)
bufMasterExternalTcpAddr MasterInfoBuf
buf
    , masterExternalTcpPort :: Int
masterExternalTcpPort =
          Int32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int32 -> Int) -> Int32 -> Int
forall a b. (a -> b) -> a -> b
$ Field 2 (RequiredField (Always (Value Int32)))
-> FieldType (Field 2 (RequiredField (Always (Value Int32))))
forall a. HasField a => a -> FieldType a
getField (Field 2 (RequiredField (Always (Value Int32)))
 -> FieldType (Field 2 (RequiredField (Always (Value Int32)))))
-> Field 2 (RequiredField (Always (Value Int32)))
-> FieldType (Field 2 (RequiredField (Always (Value Int32))))
forall a b. (a -> b) -> a -> b
$ MasterInfoBuf -> Required 2 (Value Int32)
bufMasterExternalTcpPort MasterInfoBuf
buf
    , masterExternalHttpAddr :: String
masterExternalHttpAddr =
          Text -> [Element Text]
forall mono. MonoFoldable mono => mono -> [Element mono]
unpack (Text -> [Element Text]) -> Text -> [Element Text]
forall a b. (a -> b) -> a -> b
$ Field 3 (RequiredField (Always (Value Text)))
-> FieldType (Field 3 (RequiredField (Always (Value Text))))
forall a. HasField a => a -> FieldType a
getField (Field 3 (RequiredField (Always (Value Text)))
 -> FieldType (Field 3 (RequiredField (Always (Value Text)))))
-> Field 3 (RequiredField (Always (Value Text)))
-> FieldType (Field 3 (RequiredField (Always (Value Text))))
forall a b. (a -> b) -> a -> b
$ MasterInfoBuf -> Required 3 (Value Text)
bufMasterExternalHttpAddr MasterInfoBuf
buf
    , masterExternalHttpPort :: Int
masterExternalHttpPort =
          Int32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int32 -> Int) -> Int32 -> Int
forall a b. (a -> b) -> a -> b
$ Field 4 (RequiredField (Always (Value Int32)))
-> FieldType (Field 4 (RequiredField (Always (Value Int32))))
forall a. HasField a => a -> FieldType a
getField (Field 4 (RequiredField (Always (Value Int32)))
 -> FieldType (Field 4 (RequiredField (Always (Value Int32)))))
-> Field 4 (RequiredField (Always (Value Int32)))
-> FieldType (Field 4 (RequiredField (Always (Value Int32))))
forall a b. (a -> b) -> a -> b
$ MasterInfoBuf -> Required 4 (Value Int32)
bufMasterExternalHttpPort MasterInfoBuf
buf
    , masterExternalSecureTcpAddr :: Maybe String
masterExternalSecureTcpAddr =
          (Text -> String) -> Maybe Text -> Maybe String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Text -> String
forall mono. MonoFoldable mono => mono -> [Element mono]
unpack (Maybe Text -> Maybe String) -> Maybe Text -> Maybe String
forall a b. (a -> b) -> a -> b
$ Field 5 (OptionalField (Last (Value Text)))
-> FieldType (Field 5 (OptionalField (Last (Value Text))))
forall a. HasField a => a -> FieldType a
getField (Field 5 (OptionalField (Last (Value Text)))
 -> FieldType (Field 5 (OptionalField (Last (Value Text)))))
-> Field 5 (OptionalField (Last (Value Text)))
-> FieldType (Field 5 (OptionalField (Last (Value Text))))
forall a b. (a -> b) -> a -> b
$ MasterInfoBuf -> Optional 5 (Value Text)
bufMasterExternalSecureTcpAddr MasterInfoBuf
buf
    , masterExternalSecureTcpPort :: Maybe Int
masterExternalSecureTcpPort =
          (Int32 -> Int) -> Maybe Int32 -> Maybe Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Int32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Maybe Int32 -> Maybe Int) -> Maybe Int32 -> Maybe Int
forall a b. (a -> b) -> a -> b
$ Field 6 (OptionalField (Last (Value Int32)))
-> FieldType (Field 6 (OptionalField (Last (Value Int32))))
forall a. HasField a => a -> FieldType a
getField (Field 6 (OptionalField (Last (Value Int32)))
 -> FieldType (Field 6 (OptionalField (Last (Value Int32)))))
-> Field 6 (OptionalField (Last (Value Int32)))
-> FieldType (Field 6 (OptionalField (Last (Value Int32))))
forall a b. (a -> b) -> a -> b
$ MasterInfoBuf -> Optional 6 (Value Int32)
bufMasterExternalSecureTcpPort MasterInfoBuf
buf
    }

--------------------------------------------------------------------------------
masterInfoNodeEndPoints :: MasterInfo -> NodeEndPoints
masterInfoNodeEndPoints :: MasterInfo -> NodeEndPoints
masterInfoNodeEndPoints MasterInfo
info =
    EndPoint -> Maybe EndPoint -> NodeEndPoints
NodeEndPoints
        (String -> Int -> EndPoint
EndPoint (MasterInfo -> String
masterExternalTcpAddr MasterInfo
info)
                  (Int -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Int) -> Int -> Int
forall a b. (a -> b) -> a -> b
$ MasterInfo -> Int
masterExternalTcpPort MasterInfo
info))
        Maybe EndPoint
securePoint
  where
    securePoint :: Maybe EndPoint
securePoint =
        String -> Int -> EndPoint
EndPoint (String -> Int -> EndPoint)
-> Maybe String -> Maybe (Int -> EndPoint)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> MasterInfo -> Maybe String
masterExternalSecureTcpAddr MasterInfo
info
                 Maybe (Int -> EndPoint) -> Maybe Int -> Maybe EndPoint
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ((Int -> Int) -> Maybe Int -> Maybe Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Int -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Maybe Int -> Maybe Int) -> Maybe Int -> Maybe Int
forall a b. (a -> b) -> a -> b
$ MasterInfo -> Maybe Int
masterExternalSecureTcpPort MasterInfo
info)

--------------------------------------------------------------------------------
data NotHandledBuf
    = NotHandledBuf
      { NotHandledBuf -> Required 1 (Enumeration NotHandledReason)
notHandledReason :: Required 1 (Enumeration NotHandledReason)
      , NotHandledBuf -> Optional 2 (Message MasterInfoBuf)
notHandledAdditionalInfo :: Optional 2 (Message MasterInfoBuf)
      } deriving ((forall x. NotHandledBuf -> Rep NotHandledBuf x)
-> (forall x. Rep NotHandledBuf x -> NotHandledBuf)
-> Generic NotHandledBuf
forall x. Rep NotHandledBuf x -> NotHandledBuf
forall x. NotHandledBuf -> Rep NotHandledBuf x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep NotHandledBuf x -> NotHandledBuf
$cfrom :: forall x. NotHandledBuf -> Rep NotHandledBuf x
Generic, Int -> NotHandledBuf -> ShowS
[NotHandledBuf] -> ShowS
NotHandledBuf -> String
(Int -> NotHandledBuf -> ShowS)
-> (NotHandledBuf -> String)
-> ([NotHandledBuf] -> ShowS)
-> Show NotHandledBuf
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [NotHandledBuf] -> ShowS
$cshowList :: [NotHandledBuf] -> ShowS
show :: NotHandledBuf -> String
$cshow :: NotHandledBuf -> String
showsPrec :: Int -> NotHandledBuf -> ShowS
$cshowsPrec :: Int -> NotHandledBuf -> ShowS
Show)

--------------------------------------------------------------------------------
instance Decode NotHandledBuf
-- Testing purpose only
instance Encode NotHandledBuf

--------------------------------------------------------------------------------
-- | Represents a serialized event sent by the server in a subscription context.
data ResolvedEventBuf
    = ResolvedEventBuf
      { ResolvedEventBuf -> Required 1 (Message EventRecord)
resolvedEventBufEvent           :: Required 1 (Message EventRecord)
      , ResolvedEventBuf -> Optional 2 (Message EventRecord)
resolvedEventBufLink            :: Optional 2 (Message EventRecord)
      , ResolvedEventBuf -> Required 3 (Value Int64)
resolvedEventBufCommitPosition  :: Required 3 (Value Int64)
      , ResolvedEventBuf -> Required 4 (Value Int64)
resolvedEventBufPreparePosition :: Required 4 (Value Int64)
      }
    deriving ((forall x. ResolvedEventBuf -> Rep ResolvedEventBuf x)
-> (forall x. Rep ResolvedEventBuf x -> ResolvedEventBuf)
-> Generic ResolvedEventBuf
forall x. Rep ResolvedEventBuf x -> ResolvedEventBuf
forall x. ResolvedEventBuf -> Rep ResolvedEventBuf x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ResolvedEventBuf x -> ResolvedEventBuf
$cfrom :: forall x. ResolvedEventBuf -> Rep ResolvedEventBuf x
Generic, Int -> ResolvedEventBuf -> ShowS
[ResolvedEventBuf] -> ShowS
ResolvedEventBuf -> String
(Int -> ResolvedEventBuf -> ShowS)
-> (ResolvedEventBuf -> String)
-> ([ResolvedEventBuf] -> ShowS)
-> Show ResolvedEventBuf
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ResolvedEventBuf] -> ShowS
$cshowList :: [ResolvedEventBuf] -> ShowS
show :: ResolvedEventBuf -> String
$cshow :: ResolvedEventBuf -> String
showsPrec :: Int -> ResolvedEventBuf -> ShowS
$cshowsPrec :: Int -> ResolvedEventBuf -> ShowS
Show)

--------------------------------------------------------------------------------
instance Decode ResolvedEventBuf

--------------------------------------------------------------------------------
-- Result
--------------------------------------------------------------------------------
-- | A structure referring to a potential logical record position in the
--   EventStore transaction file.
data Position
    = Position
      { Position -> Int64
positionCommit  :: !Int64 -- ^ Commit position of the record
      , Position -> Int64
positionPrepare :: !Int64 -- ^ Prepare position of the record
      }
    deriving Int -> Position -> ShowS
[Position] -> ShowS
Position -> String
(Int -> Position -> ShowS)
-> (Position -> String) -> ([Position] -> ShowS) -> Show Position
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Position] -> ShowS
$cshowList :: [Position] -> ShowS
show :: Position -> String
$cshow :: Position -> String
showsPrec :: Int -> Position -> ShowS
$cshowsPrec :: Int -> Position -> ShowS
Show

--------------------------------------------------------------------------------
instance Eq Position where
    Position Int64
ac Int64
aap == :: Position -> Position -> Bool
== Position Int64
bc Int64
bp = Int64
ac Int64 -> Int64 -> Bool
forall a. Eq a => a -> a -> Bool
== Int64
bc Bool -> Bool -> Bool
&& Int64
aap Int64 -> Int64 -> Bool
forall a. Eq a => a -> a -> Bool
== Int64
bp

--------------------------------------------------------------------------------
instance Ord Position where
    compare :: Position -> Position -> Ordering
compare (Position Int64
ac Int64
aap) (Position Int64
bc Int64
bp) =
        if Int64
ac Int64 -> Int64 -> Bool
forall a. Ord a => a -> a -> Bool
< Int64
bc Bool -> Bool -> Bool
|| (Int64
ac Int64 -> Int64 -> Bool
forall a. Eq a => a -> a -> Bool
== Int64
bc Bool -> Bool -> Bool
&& Int64
aap Int64 -> Int64 -> Bool
forall a. Ord a => a -> a -> Bool
< Int64
bp)
        then Ordering
LT
        else if Int64
ac Int64 -> Int64 -> Bool
forall a. Ord a => a -> a -> Bool
> Int64
bc Bool -> Bool -> Bool
|| (Int64
ac Int64 -> Int64 -> Bool
forall a. Eq a => a -> a -> Bool
== Int64
bc Bool -> Bool -> Bool
&& Int64
aap Int64 -> Int64 -> Bool
forall a. Ord a => a -> a -> Bool
> Int64
bp)
             then Ordering
GT
             else Ordering
EQ

--------------------------------------------------------------------------------
-- | Representing the start of the transaction file.
positionStart :: Position
positionStart :: Position
positionStart = Int64 -> Int64 -> Position
Position Int64
0 Int64
0

--------------------------------------------------------------------------------
-- | Representing the end of the transaction file.
positionEnd :: Position
positionEnd :: Position
positionEnd = Int64 -> Int64 -> Position
Position (-Int64
1) (-Int64
1)

--------------------------------------------------------------------------------
-- | Represents a previously written event.
data RecordedEvent
    = RecordedEvent
      { RecordedEvent -> Text
recordedEventStreamId :: !Text
        -- ^ The event stream that this event  belongs to.
      , RecordedEvent -> UUID
recordedEventId :: !UUID
        -- ^ Unique identifier representing this event.
      , RecordedEvent -> Int64
recordedEventNumber :: !Int64
        -- ^ Number of this event in the stream.
      , RecordedEvent -> Text
recordedEventType :: !Text
        -- ^ Type of this event.
      , RecordedEvent -> ByteString
recordedEventData :: !ByteString
        -- ^ Representing the data of this event.
      , RecordedEvent -> Maybe ByteString
recordedEventMetadata :: !(Maybe ByteString)
        -- ^ Representing the metadada associated with this event.
      , RecordedEvent -> Bool
recordedEventIsJson :: !Bool
        -- ^ Indicates whether the content is internally marked as json.
      , RecordedEvent -> Maybe UTCTime
recordedEventCreated :: !(Maybe UTCTime)
        -- ^ Representing when this event was created in the system.
      }
    deriving Int -> RecordedEvent -> ShowS
[RecordedEvent] -> ShowS
RecordedEvent -> String
(Int -> RecordedEvent -> ShowS)
-> (RecordedEvent -> String)
-> ([RecordedEvent] -> ShowS)
-> Show RecordedEvent
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RecordedEvent] -> ShowS
$cshowList :: [RecordedEvent] -> ShowS
show :: RecordedEvent -> String
$cshow :: RecordedEvent -> String
showsPrec :: Int -> RecordedEvent -> ShowS
$cshowsPrec :: Int -> RecordedEvent -> ShowS
Show

--------------------------------------------------------------------------------
-- | Tries to parse JSON object from the given 'RecordedEvent'.
recordedEventDataAsJson :: A.FromJSON a => RecordedEvent -> Maybe a
recordedEventDataAsJson :: RecordedEvent -> Maybe a
recordedEventDataAsJson = ByteString -> Maybe a
forall a. FromJSON a => ByteString -> Maybe a
A.decode (ByteString -> Maybe a)
-> (RecordedEvent -> ByteString) -> RecordedEvent -> Maybe a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
forall lazy strict. LazySequence lazy strict => strict -> lazy
fromStrict (ByteString -> ByteString)
-> (RecordedEvent -> ByteString) -> RecordedEvent -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RecordedEvent -> ByteString
recordedEventData

--------------------------------------------------------------------------------
-- | Converts a raw 'Int64' into an 'UTCTime'
-- fromIntegral should be a no-op in GHC and allow eventstore to compile w GHCJS
-- GHCJS maps CTime to Int32 (cf PR https://github.com/YoEight/eventstore/pull/47)
toUTC :: Int64 -> UTCTime
toUTC :: Int64 -> UTCTime
toUTC = POSIXTime -> UTCTime
posixSecondsToUTCTime (POSIXTime -> UTCTime) -> (Int64 -> POSIXTime) -> Int64 -> UTCTime
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (POSIXTime -> POSIXTime -> POSIXTime
forall a. Fractional a => a -> a -> a
/POSIXTime
1000) (POSIXTime -> POSIXTime)
-> (Int64 -> POSIXTime) -> Int64 -> POSIXTime
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CTime -> POSIXTime
forall a b. (Real a, Fractional b) => a -> b
realToFrac (CTime -> POSIXTime) -> (Int64 -> CTime) -> Int64 -> POSIXTime
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int64 -> CTime
CTime (Int64 -> CTime) -> (Int64 -> Int64) -> Int64 -> CTime
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int64 -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral

--------------------------------------------------------------------------------
-- | Constructs a 'RecordedEvent' from an 'EventRecord'.
newRecordedEvent :: EventRecord -> RecordedEvent
newRecordedEvent :: EventRecord -> RecordedEvent
newRecordedEvent EventRecord
er = RecordedEvent
re
  where
    evt_id :: FieldType (Field 3 (RequiredField (Always (Value ByteString))))
evt_id      = Field 3 (RequiredField (Always (Value ByteString)))
-> FieldType (Field 3 (RequiredField (Always (Value ByteString))))
forall a. HasField a => a -> FieldType a
getField (Field 3 (RequiredField (Always (Value ByteString)))
 -> FieldType (Field 3 (RequiredField (Always (Value ByteString)))))
-> Field 3 (RequiredField (Always (Value ByteString)))
-> FieldType (Field 3 (RequiredField (Always (Value ByteString))))
forall a b. (a -> b) -> a -> b
$ EventRecord -> Required 3 (Value ByteString)
eventRecordId EventRecord
er
    evt_uuid :: UUID
evt_uuid    = Maybe UUID -> UUID
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe UUID -> UUID) -> Maybe UUID -> UUID
forall a b. (a -> b) -> a -> b
$ ByteString -> Maybe UUID
fromByteString (ByteString -> Maybe UUID) -> ByteString -> Maybe UUID
forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString
forall lazy strict. LazySequence lazy strict => strict -> lazy
fromStrict ByteString
FieldType (Field 3 (RequiredField (Always (Value ByteString))))
evt_id
    data_type :: FieldType (Field 5 (RequiredField (Always (Value Int32))))
data_type   = Field 5 (RequiredField (Always (Value Int32)))
-> FieldType (Field 5 (RequiredField (Always (Value Int32))))
forall a. HasField a => a -> FieldType a
getField (Field 5 (RequiredField (Always (Value Int32)))
 -> FieldType (Field 5 (RequiredField (Always (Value Int32)))))
-> Field 5 (RequiredField (Always (Value Int32)))
-> FieldType (Field 5 (RequiredField (Always (Value Int32))))
forall a b. (a -> b) -> a -> b
$ EventRecord -> Required 5 (Value Int32)
eventRecordDataType EventRecord
er
    epoch :: FieldType (Field 10 (OptionalField (Last (Value Int64))))
epoch       = Field 10 (OptionalField (Last (Value Int64)))
-> FieldType (Field 10 (OptionalField (Last (Value Int64))))
forall a. HasField a => a -> FieldType a
getField (Field 10 (OptionalField (Last (Value Int64)))
 -> FieldType (Field 10 (OptionalField (Last (Value Int64)))))
-> Field 10 (OptionalField (Last (Value Int64)))
-> FieldType (Field 10 (OptionalField (Last (Value Int64))))
forall a b. (a -> b) -> a -> b
$ EventRecord -> Optional 10 (Value Int64)
eventRecordCreatedEpoch EventRecord
er
    utc_created :: Maybe UTCTime
utc_created = (Int64 -> UTCTime) -> Maybe Int64 -> Maybe UTCTime
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Int64 -> UTCTime
toUTC Maybe Int64
FieldType (Field 10 (OptionalField (Last (Value Int64))))
epoch

    re :: RecordedEvent
re = RecordedEvent :: Text
-> UUID
-> Int64
-> Text
-> ByteString
-> Maybe ByteString
-> Bool
-> Maybe UTCTime
-> RecordedEvent
RecordedEvent
         { recordedEventStreamId :: Text
recordedEventStreamId     = Field 1 (RequiredField (Always (Value Text)))
-> FieldType (Field 1 (RequiredField (Always (Value Text))))
forall a. HasField a => a -> FieldType a
getField (Field 1 (RequiredField (Always (Value Text)))
 -> FieldType (Field 1 (RequiredField (Always (Value Text)))))
-> Field 1 (RequiredField (Always (Value Text)))
-> FieldType (Field 1 (RequiredField (Always (Value Text))))
forall a b. (a -> b) -> a -> b
$ EventRecord -> Required 1 (Value Text)
eventRecordStreamId EventRecord
er
         , recordedEventNumber :: Int64
recordedEventNumber       = Field 2 (RequiredField (Always (Value Int64)))
-> FieldType (Field 2 (RequiredField (Always (Value Int64))))
forall a. HasField a => a -> FieldType a
getField (Field 2 (RequiredField (Always (Value Int64)))
 -> FieldType (Field 2 (RequiredField (Always (Value Int64)))))
-> Field 2 (RequiredField (Always (Value Int64)))
-> FieldType (Field 2 (RequiredField (Always (Value Int64))))
forall a b. (a -> b) -> a -> b
$ EventRecord -> Required 2 (Value Int64)
eventRecordNumber EventRecord
er
         , recordedEventId :: UUID
recordedEventId           = UUID
evt_uuid
         , recordedEventType :: Text
recordedEventType         = Field 4 (RequiredField (Always (Value Text)))
-> FieldType (Field 4 (RequiredField (Always (Value Text))))
forall a. HasField a => a -> FieldType a
getField (Field 4 (RequiredField (Always (Value Text)))
 -> FieldType (Field 4 (RequiredField (Always (Value Text)))))
-> Field 4 (RequiredField (Always (Value Text)))
-> FieldType (Field 4 (RequiredField (Always (Value Text))))
forall a b. (a -> b) -> a -> b
$ EventRecord -> Required 4 (Value Text)
eventRecordType EventRecord
er
         , recordedEventData :: ByteString
recordedEventData         = Field 7 (RequiredField (Always (Value ByteString)))
-> FieldType (Field 7 (RequiredField (Always (Value ByteString))))
forall a. HasField a => a -> FieldType a
getField (Field 7 (RequiredField (Always (Value ByteString)))
 -> FieldType (Field 7 (RequiredField (Always (Value ByteString)))))
-> Field 7 (RequiredField (Always (Value ByteString)))
-> FieldType (Field 7 (RequiredField (Always (Value ByteString))))
forall a b. (a -> b) -> a -> b
$ EventRecord -> Required 7 (Value ByteString)
eventRecordData EventRecord
er
         , recordedEventMetadata :: Maybe ByteString
recordedEventMetadata     = Field 8 (OptionalField (Last (Value ByteString)))
-> FieldType (Field 8 (OptionalField (Last (Value ByteString))))
forall a. HasField a => a -> FieldType a
getField (Field 8 (OptionalField (Last (Value ByteString)))
 -> FieldType (Field 8 (OptionalField (Last (Value ByteString)))))
-> Field 8 (OptionalField (Last (Value ByteString)))
-> FieldType (Field 8 (OptionalField (Last (Value ByteString))))
forall a b. (a -> b) -> a -> b
$ EventRecord -> Optional 8 (Value ByteString)
eventRecordMetadata EventRecord
er
         , recordedEventIsJson :: Bool
recordedEventIsJson       = Int32
FieldType (Field 5 (RequiredField (Always (Value Int32))))
data_type Int32 -> Int32 -> Bool
forall a. Eq a => a -> a -> Bool
== Int32
1
         , recordedEventCreated :: Maybe UTCTime
recordedEventCreated      = Maybe UTCTime
utc_created
         }

--------------------------------------------------------------------------------
-- | A structure representing a single event or an resolved link event.
data ResolvedEvent
    = ResolvedEvent
      { ResolvedEvent -> Maybe RecordedEvent
resolvedEventRecord :: !(Maybe RecordedEvent)
        -- ^ The event, or the resolved link event if this 'ResolvedEvent' is a
        --   link event.
      , ResolvedEvent -> Maybe RecordedEvent
resolvedEventLink :: !(Maybe RecordedEvent)
        -- ^ The link event if this 'ResolvedEvent' is a link event.
      , ResolvedEvent -> Maybe Position
resolvedEventPosition :: !(Maybe Position)
        -- ^ Possible 'Position' of that event.
      }
    deriving Int -> ResolvedEvent -> ShowS
[ResolvedEvent] -> ShowS
ResolvedEvent -> String
(Int -> ResolvedEvent -> ShowS)
-> (ResolvedEvent -> String)
-> ([ResolvedEvent] -> ShowS)
-> Show ResolvedEvent
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ResolvedEvent] -> ShowS
$cshowList :: [ResolvedEvent] -> ShowS
show :: ResolvedEvent -> String
$cshow :: ResolvedEvent -> String
showsPrec :: Int -> ResolvedEvent -> ShowS
$cshowsPrec :: Int -> ResolvedEvent -> ShowS
Show

--------------------------------------------------------------------------------
-- | Constructs a 'ResolvedEvent' from a 'ResolvedIndexedEvent'.
newResolvedEvent :: ResolvedIndexedEvent -> ResolvedEvent
newResolvedEvent :: ResolvedIndexedEvent -> ResolvedEvent
newResolvedEvent ResolvedIndexedEvent
rie = ResolvedEvent
re
  where
    record :: FieldType (Field 1 (OptionalField (Maybe (Message EventRecord))))
record = Field 1 (OptionalField (Maybe (Message EventRecord)))
-> FieldType
     (Field 1 (OptionalField (Maybe (Message EventRecord))))
forall a. HasField a => a -> FieldType a
getField (Field 1 (OptionalField (Maybe (Message EventRecord)))
 -> FieldType
      (Field 1 (OptionalField (Maybe (Message EventRecord)))))
-> Field 1 (OptionalField (Maybe (Message EventRecord)))
-> FieldType
     (Field 1 (OptionalField (Maybe (Message EventRecord))))
forall a b. (a -> b) -> a -> b
$ ResolvedIndexedEvent -> Optional 1 (Message EventRecord)
resolvedIndexedRecord ResolvedIndexedEvent
rie
    lnk :: FieldType (Field 2 (OptionalField (Maybe (Message EventRecord))))
lnk    = Field 2 (OptionalField (Maybe (Message EventRecord)))
-> FieldType
     (Field 2 (OptionalField (Maybe (Message EventRecord))))
forall a. HasField a => a -> FieldType a
getField (Field 2 (OptionalField (Maybe (Message EventRecord)))
 -> FieldType
      (Field 2 (OptionalField (Maybe (Message EventRecord)))))
-> Field 2 (OptionalField (Maybe (Message EventRecord)))
-> FieldType
     (Field 2 (OptionalField (Maybe (Message EventRecord))))
forall a b. (a -> b) -> a -> b
$ ResolvedIndexedEvent -> Optional 2 (Message EventRecord)
resolvedIndexedLink ResolvedIndexedEvent
rie
    re :: ResolvedEvent
re     = ResolvedEvent :: Maybe RecordedEvent
-> Maybe RecordedEvent -> Maybe Position -> ResolvedEvent
ResolvedEvent
             { resolvedEventRecord :: Maybe RecordedEvent
resolvedEventRecord   = (EventRecord -> RecordedEvent)
-> Maybe EventRecord -> Maybe RecordedEvent
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap EventRecord -> RecordedEvent
newRecordedEvent Maybe EventRecord
FieldType (Field 1 (OptionalField (Maybe (Message EventRecord))))
record
             , resolvedEventLink :: Maybe RecordedEvent
resolvedEventLink     = (EventRecord -> RecordedEvent)
-> Maybe EventRecord -> Maybe RecordedEvent
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap EventRecord -> RecordedEvent
newRecordedEvent Maybe EventRecord
FieldType (Field 2 (OptionalField (Maybe (Message EventRecord))))
lnk
             , resolvedEventPosition :: Maybe Position
resolvedEventPosition = Maybe Position
forall a. Maybe a
Nothing
             }

--------------------------------------------------------------------------------
-- | Constructs a 'ResolvedEvent' from a 'ResolvedEventBuf'.
newResolvedEventFromBuf :: ResolvedEventBuf -> ResolvedEvent
newResolvedEventFromBuf :: ResolvedEventBuf -> ResolvedEvent
newResolvedEventFromBuf ResolvedEventBuf
reb = ResolvedEvent
re
  where
    record :: Maybe RecordedEvent
record = RecordedEvent -> Maybe RecordedEvent
forall a. a -> Maybe a
Just (RecordedEvent -> Maybe RecordedEvent)
-> RecordedEvent -> Maybe RecordedEvent
forall a b. (a -> b) -> a -> b
$ EventRecord -> RecordedEvent
newRecordedEvent (EventRecord -> RecordedEvent) -> EventRecord -> RecordedEvent
forall a b. (a -> b) -> a -> b
$ Field 1 (RequiredField (Always (Message EventRecord)))
-> FieldType
     (Field 1 (RequiredField (Always (Message EventRecord))))
forall a. HasField a => a -> FieldType a
getField (Field 1 (RequiredField (Always (Message EventRecord)))
 -> FieldType
      (Field 1 (RequiredField (Always (Message EventRecord)))))
-> Field 1 (RequiredField (Always (Message EventRecord)))
-> FieldType
     (Field 1 (RequiredField (Always (Message EventRecord))))
forall a b. (a -> b) -> a -> b
$ ResolvedEventBuf -> Required 1 (Message EventRecord)
resolvedEventBufEvent ResolvedEventBuf
reb
    lnk :: FieldType (Field 2 (OptionalField (Maybe (Message EventRecord))))
lnk    = Field 2 (OptionalField (Maybe (Message EventRecord)))
-> FieldType
     (Field 2 (OptionalField (Maybe (Message EventRecord))))
forall a. HasField a => a -> FieldType a
getField (Field 2 (OptionalField (Maybe (Message EventRecord)))
 -> FieldType
      (Field 2 (OptionalField (Maybe (Message EventRecord)))))
-> Field 2 (OptionalField (Maybe (Message EventRecord)))
-> FieldType
     (Field 2 (OptionalField (Maybe (Message EventRecord))))
forall a b. (a -> b) -> a -> b
$ ResolvedEventBuf -> Optional 2 (Message EventRecord)
resolvedEventBufLink ResolvedEventBuf
reb
    com :: FieldType (Field 3 (RequiredField (Always (Value Int64))))
com    = Field 3 (RequiredField (Always (Value Int64)))
-> FieldType (Field 3 (RequiredField (Always (Value Int64))))
forall a. HasField a => a -> FieldType a
getField (Field 3 (RequiredField (Always (Value Int64)))
 -> FieldType (Field 3 (RequiredField (Always (Value Int64)))))
-> Field 3 (RequiredField (Always (Value Int64)))
-> FieldType (Field 3 (RequiredField (Always (Value Int64))))
forall a b. (a -> b) -> a -> b
$ ResolvedEventBuf -> Required 3 (Value Int64)
resolvedEventBufCommitPosition ResolvedEventBuf
reb
    pre :: FieldType (Field 4 (RequiredField (Always (Value Int64))))
pre    = Field 4 (RequiredField (Always (Value Int64)))
-> FieldType (Field 4 (RequiredField (Always (Value Int64))))
forall a. HasField a => a -> FieldType a
getField (Field 4 (RequiredField (Always (Value Int64)))
 -> FieldType (Field 4 (RequiredField (Always (Value Int64)))))
-> Field 4 (RequiredField (Always (Value Int64)))
-> FieldType (Field 4 (RequiredField (Always (Value Int64))))
forall a b. (a -> b) -> a -> b
$ ResolvedEventBuf -> Required 4 (Value Int64)
resolvedEventBufPreparePosition ResolvedEventBuf
reb
    pos :: Position
pos    = Int64 -> Int64 -> Position
Position Int64
FieldType (Field 3 (RequiredField (Always (Value Int64))))
com Int64
FieldType (Field 4 (RequiredField (Always (Value Int64))))
pre
    re :: ResolvedEvent
re     = ResolvedEvent :: Maybe RecordedEvent
-> Maybe RecordedEvent -> Maybe Position -> ResolvedEvent
ResolvedEvent
             { resolvedEventRecord :: Maybe RecordedEvent
resolvedEventRecord   = Maybe RecordedEvent
record
             , resolvedEventLink :: Maybe RecordedEvent
resolvedEventLink     = (EventRecord -> RecordedEvent)
-> Maybe EventRecord -> Maybe RecordedEvent
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap EventRecord -> RecordedEvent
newRecordedEvent Maybe EventRecord
FieldType (Field 2 (OptionalField (Maybe (Message EventRecord))))
lnk
             , resolvedEventPosition :: Maybe Position
resolvedEventPosition = Position -> Maybe Position
forall a. a -> Maybe a
Just Position
pos
             }

--------------------------------------------------------------------------------
-- | Returns the event that was read or which triggered the subscription.
--
--   If this 'ResolvedEvent' represents a link event, the link will be the
--   original event, otherwise it will be the event.
resolvedEventOriginal :: ResolvedEvent -> RecordedEvent
resolvedEventOriginal :: ResolvedEvent -> RecordedEvent
resolvedEventOriginal (ResolvedEvent Maybe RecordedEvent
record Maybe RecordedEvent
lnk Maybe Position
_) =
    let Just RecordedEvent
evt = Maybe RecordedEvent
lnk Maybe RecordedEvent -> Maybe RecordedEvent -> Maybe RecordedEvent
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe RecordedEvent
record in RecordedEvent
evt

--------------------------------------------------------------------------------
-- | Tries to desarialize 'resolvedEventOriginal' data as JSON.
resolvedEventDataAsJson :: A.FromJSON a => ResolvedEvent -> Maybe a
resolvedEventDataAsJson :: ResolvedEvent -> Maybe a
resolvedEventDataAsJson = RecordedEvent -> Maybe a
forall a. FromJSON a => RecordedEvent -> Maybe a
recordedEventDataAsJson (RecordedEvent -> Maybe a)
-> (ResolvedEvent -> RecordedEvent) -> ResolvedEvent -> Maybe a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ResolvedEvent -> RecordedEvent
resolvedEventOriginal

--------------------------------------------------------------------------------
-- | Indicates whether this 'ResolvedEvent' is a resolved link event.
isEventResolvedLink :: ResolvedEvent -> Bool
isEventResolvedLink :: ResolvedEvent -> Bool
isEventResolvedLink = Maybe RecordedEvent -> Bool
forall a. Maybe a -> Bool
isJust (Maybe RecordedEvent -> Bool)
-> (ResolvedEvent -> Maybe RecordedEvent) -> ResolvedEvent -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ResolvedEvent -> Maybe RecordedEvent
resolvedEventLink

--------------------------------------------------------------------------------
-- | The stream name of the original event.
resolvedEventOriginalStreamId :: ResolvedEvent -> Text
resolvedEventOriginalStreamId :: ResolvedEvent -> Text
resolvedEventOriginalStreamId = RecordedEvent -> Text
recordedEventStreamId (RecordedEvent -> Text)
-> (ResolvedEvent -> RecordedEvent) -> ResolvedEvent -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ResolvedEvent -> RecordedEvent
resolvedEventOriginal

--------------------------------------------------------------------------------
-- | The ID of the original event.
resolvedEventOriginalId :: ResolvedEvent -> UUID
resolvedEventOriginalId :: ResolvedEvent -> UUID
resolvedEventOriginalId = RecordedEvent -> UUID
recordedEventId (RecordedEvent -> UUID)
-> (ResolvedEvent -> RecordedEvent) -> ResolvedEvent -> UUID
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ResolvedEvent -> RecordedEvent
resolvedEventOriginal

--------------------------------------------------------------------------------
-- | The event number of the original event.
resolvedEventOriginalEventNumber :: ResolvedEvent -> Int64
resolvedEventOriginalEventNumber :: ResolvedEvent -> Int64
resolvedEventOriginalEventNumber = RecordedEvent -> Int64
recordedEventNumber (RecordedEvent -> Int64)
-> (ResolvedEvent -> RecordedEvent) -> ResolvedEvent -> Int64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ResolvedEvent -> RecordedEvent
resolvedEventOriginal

--------------------------------------------------------------------------------
-- | Represents the direction of read operation (both from $all an usual
--   streams).
data ReadDirection
    = Forward  -- ^ From beginning to end
    | Backward -- ^ From end to beginning
    deriving (ReadDirection -> ReadDirection -> Bool
(ReadDirection -> ReadDirection -> Bool)
-> (ReadDirection -> ReadDirection -> Bool) -> Eq ReadDirection
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ReadDirection -> ReadDirection -> Bool
$c/= :: ReadDirection -> ReadDirection -> Bool
== :: ReadDirection -> ReadDirection -> Bool
$c== :: ReadDirection -> ReadDirection -> Bool
Eq, Int -> ReadDirection -> ShowS
[ReadDirection] -> ShowS
ReadDirection -> String
(Int -> ReadDirection -> ShowS)
-> (ReadDirection -> String)
-> ([ReadDirection] -> ShowS)
-> Show ReadDirection
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ReadDirection] -> ShowS
$cshowList :: [ReadDirection] -> ShowS
show :: ReadDirection -> String
$cshow :: ReadDirection -> String
showsPrec :: Int -> ReadDirection -> ShowS
$cshowsPrec :: Int -> ReadDirection -> ShowS
Show)

--------------------------------------------------------------------------------
-- Package
--------------------------------------------------------------------------------
-- | Represents a package exchanged between the client and the server.
data Package
    = Package
      { Package -> Command
packageCmd         :: !Command
      , Package -> UUID
packageCorrelation :: !UUID
      , Package -> ByteString
packageData        :: !ByteString
      , Package -> Maybe Credentials
packageCred        :: !(Maybe Credentials)
      }

--------------------------------------------------------------------------------
instance Show Package where
  show :: Package -> String
show Package{Maybe Credentials
ByteString
UUID
Command
packageCred :: Maybe Credentials
packageData :: ByteString
packageCorrelation :: UUID
packageCmd :: Command
packageCred :: Package -> Maybe Credentials
packageData :: Package -> ByteString
packageCorrelation :: Package -> UUID
packageCmd :: Package -> Command
..} =
    String
"Package [" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> UUID -> String
forall a. Show a => a -> String
show UUID
packageCorrelation
                String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
"], command: "
                String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Command -> String
forall a. Show a => a -> String
show Command
packageCmd

--------------------------------------------------------------------------------
packageDataAsText :: Package -> Maybe Text
packageDataAsText :: Package -> Maybe Text
packageDataAsText = Text -> Maybe Text
forall a. (Eq a, IsString a) => a -> Maybe a
go (Text -> Maybe Text) -> (Package -> Text) -> Package -> Maybe Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Text
forall textual binary. Utf8 textual binary => binary -> textual
decodeUtf8 (ByteString -> Text) -> (Package -> ByteString) -> Package -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Package -> ByteString
packageData
  where
    go :: a -> Maybe a
go a
"" = Maybe a
forall a. Maybe a
Nothing
    go a
t  = a -> Maybe a
forall a. a -> Maybe a
Just a
t

--------------------------------------------------------------------------------
heartbeatRequestPackage :: UUID -> Package
heartbeatRequestPackage :: UUID -> Package
heartbeatRequestPackage UUID
uuid =
  Package :: Command -> UUID -> ByteString -> Maybe Credentials -> Package
Package
  { packageCmd :: Command
packageCmd         = Command
heartbeatRequestCmd
  , packageCorrelation :: UUID
packageCorrelation = UUID
uuid
  , packageData :: ByteString
packageData        = ByteString
""
  , packageCred :: Maybe Credentials
packageCred        = Maybe Credentials
forall a. Maybe a
Nothing
  }

--------------------------------------------------------------------------------
-- | Constructs a heartbeat response given the 'UUID' of heartbeat request.
heartbeatResponsePackage :: UUID -> Package
heartbeatResponsePackage :: UUID -> Package
heartbeatResponsePackage UUID
uuid =
    Package :: Command -> UUID -> ByteString -> Maybe Credentials -> Package
Package
    { packageCmd :: Command
packageCmd         = Command
heartbeatResponseCmd
    , packageCorrelation :: UUID
packageCorrelation = UUID
uuid
    , packageData :: ByteString
packageData        = ByteString
""
    , packageCred :: Maybe Credentials
packageCred        = Maybe Credentials
forall a. Maybe a
Nothing
    }

--------------------------------------------------------------------------------
-- | Represents an access control list for a stream.
data StreamACL
    = StreamACL
      { StreamACL -> Maybe [Text]
streamACLReadRoles :: !(Maybe [Text])
        -- ^ Roles and users permitted to read the stream.
      , StreamACL -> Maybe [Text]
streamACLWriteRoles :: !(Maybe [Text])
        -- ^ Roles and users permitted to write to the stream.
      , StreamACL -> Maybe [Text]
streamACLDeleteRoles :: !(Maybe [Text])
        -- ^ Roles and users permitted to delete to the stream.
      , StreamACL -> Maybe [Text]
streamACLMetaReadRoles :: !(Maybe [Text])
        -- ^ Roles and users permitted to read stream metadata.
      , StreamACL -> Maybe [Text]
streamACLMetaWriteRoles :: !(Maybe [Text])
        -- ^ Roles and users permitted to write stream metadata.
      } deriving (Int -> StreamACL -> ShowS
[StreamACL] -> ShowS
StreamACL -> String
(Int -> StreamACL -> ShowS)
-> (StreamACL -> String)
-> ([StreamACL] -> ShowS)
-> Show StreamACL
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [StreamACL] -> ShowS
$cshowList :: [StreamACL] -> ShowS
show :: StreamACL -> String
$cshow :: StreamACL -> String
showsPrec :: Int -> StreamACL -> ShowS
$cshowsPrec :: Int -> StreamACL -> ShowS
Show, StreamACL -> StreamACL -> Bool
(StreamACL -> StreamACL -> Bool)
-> (StreamACL -> StreamACL -> Bool) -> Eq StreamACL
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: StreamACL -> StreamACL -> Bool
$c/= :: StreamACL -> StreamACL -> Bool
== :: StreamACL -> StreamACL -> Bool
$c== :: StreamACL -> StreamACL -> Bool
Eq)

-------------------------------------------------------------------------------
instance A.FromJSON StreamACL where
    parseJSON :: Value -> Parser StreamACL
parseJSON = Value -> Parser StreamACL
parseStreamACL

-------------------------------------------------------------------------------
instance A.ToJSON StreamACL where
    toJSON :: StreamACL -> Value
toJSON = StreamACL -> Value
streamACLJSON

--------------------------------------------------------------------------------
-- | 'StreamACL' with no role or users whatsoever.
emptyStreamACL :: StreamACL
emptyStreamACL :: StreamACL
emptyStreamACL = StreamACL :: Maybe [Text]
-> Maybe [Text]
-> Maybe [Text]
-> Maybe [Text]
-> Maybe [Text]
-> StreamACL
StreamACL
                 { streamACLReadRoles :: Maybe [Text]
streamACLReadRoles      = Maybe [Text]
forall a. Maybe a
Nothing
                 , streamACLWriteRoles :: Maybe [Text]
streamACLWriteRoles     = Maybe [Text]
forall a. Maybe a
Nothing
                 , streamACLDeleteRoles :: Maybe [Text]
streamACLDeleteRoles    = Maybe [Text]
forall a. Maybe a
Nothing
                 , streamACLMetaReadRoles :: Maybe [Text]
streamACLMetaReadRoles  = Maybe [Text]
forall a. Maybe a
Nothing
                 , streamACLMetaWriteRoles :: Maybe [Text]
streamACLMetaWriteRoles = Maybe [Text]
forall a. Maybe a
Nothing
                 }

--------------------------------------------------------------------------------
-- | Represents stream metadata with strongly typed properties for system values
--   and a dictionary-like interface for custom values.
data StreamMetadata
    = StreamMetadata
      { StreamMetadata -> Maybe Int32
streamMetadataMaxCount :: !(Maybe Int32)
        -- ^ The maximum number of events allowed in the stream.
      , StreamMetadata -> Maybe TimeSpan
streamMetadataMaxAge :: !(Maybe TimeSpan)
        -- ^ The maximum age of events allowed in the stream.
      , StreamMetadata -> Maybe Int32
streamMetadataTruncateBefore :: !(Maybe Int32)
        -- ^ The event number from which previous events can be scavenged. This
        --   is used to implement soft-deletion of streams.
      , StreamMetadata -> Maybe TimeSpan
streamMetadataCacheControl :: !(Maybe TimeSpan)
        -- ^ The amount of time for which the stream head is cachable.
      , StreamMetadata -> Maybe StreamACL
streamMetadataACL :: !(Maybe StreamACL)
        -- ^ The access control list for the stream.
      , StreamMetadata -> Object
streamMetadataCustom :: !Object
        -- ^ An enumerable of key-value pairs of keys to JSON text for
        --   user-provider metadata.
      } deriving (Int -> StreamMetadata -> ShowS
[StreamMetadata] -> ShowS
StreamMetadata -> String
(Int -> StreamMetadata -> ShowS)
-> (StreamMetadata -> String)
-> ([StreamMetadata] -> ShowS)
-> Show StreamMetadata
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [StreamMetadata] -> ShowS
$cshowList :: [StreamMetadata] -> ShowS
show :: StreamMetadata -> String
$cshow :: StreamMetadata -> String
showsPrec :: Int -> StreamMetadata -> ShowS
$cshowsPrec :: Int -> StreamMetadata -> ShowS
Show, StreamMetadata -> StreamMetadata -> Bool
(StreamMetadata -> StreamMetadata -> Bool)
-> (StreamMetadata -> StreamMetadata -> Bool) -> Eq StreamMetadata
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: StreamMetadata -> StreamMetadata -> Bool
$c/= :: StreamMetadata -> StreamMetadata -> Bool
== :: StreamMetadata -> StreamMetadata -> Bool
$c== :: StreamMetadata -> StreamMetadata -> Bool
Eq)

--------------------------------------------------------------------------------
-- | Gets a custom property value from metadata.
getCustomPropertyValue :: StreamMetadata -> A.Key -> Maybe A.Value
getCustomPropertyValue :: StreamMetadata -> Key -> Maybe Value
getCustomPropertyValue StreamMetadata
s Key
k = Key -> Object -> Maybe Value
forall v. Key -> KeyMap v -> Maybe v
KeyMap.lookup Key
k Object
obj
  where
    obj :: Object
obj = StreamMetadata -> Object
streamMetadataCustom StreamMetadata
s

--------------------------------------------------------------------------------
-- | Get a custom property value from metadata.
getCustomProperty :: A.FromJSON a => StreamMetadata -> A.Key -> Maybe a
getCustomProperty :: StreamMetadata -> Key -> Maybe a
getCustomProperty StreamMetadata
s Key
k = do
    Value
v <- StreamMetadata -> Key -> Maybe Value
getCustomPropertyValue StreamMetadata
s Key
k
    case Value -> Result a
forall a. FromJSON a => Value -> Result a
A.fromJSON Value
v of
        A.Error String
_   -> Maybe a
forall a. Maybe a
Nothing
        A.Success a
a -> a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return a
a

-------------------------------------------------------------------------------
instance A.FromJSON StreamMetadata where
    parseJSON :: Value -> Parser StreamMetadata
parseJSON = Value -> Parser StreamMetadata
parseStreamMetadata

-------------------------------------------------------------------------------
instance A.ToJSON StreamMetadata where
    toJSON :: StreamMetadata -> Value
toJSON = StreamMetadata -> Value
streamMetadataJSON

--------------------------------------------------------------------------------
-- | 'StreamMetadata' with everything set to 'Nothing', using 'emptyStreamACL'
--   and an empty 'Object'.
emptyStreamMetadata :: StreamMetadata
emptyStreamMetadata :: StreamMetadata
emptyStreamMetadata = StreamMetadata :: Maybe Int32
-> Maybe TimeSpan
-> Maybe Int32
-> Maybe TimeSpan
-> Maybe StreamACL
-> Object
-> StreamMetadata
StreamMetadata
                      { streamMetadataMaxCount :: Maybe Int32
streamMetadataMaxCount       = Maybe Int32
forall a. Maybe a
Nothing
                      , streamMetadataMaxAge :: Maybe TimeSpan
streamMetadataMaxAge         = Maybe TimeSpan
forall a. Maybe a
Nothing
                      , streamMetadataTruncateBefore :: Maybe Int32
streamMetadataTruncateBefore = Maybe Int32
forall a. Maybe a
Nothing
                      , streamMetadataCacheControl :: Maybe TimeSpan
streamMetadataCacheControl   = Maybe TimeSpan
forall a. Maybe a
Nothing
                      , streamMetadataACL :: Maybe StreamACL
streamMetadataACL            = Maybe StreamACL
forall a. Maybe a
Nothing
                      , streamMetadataCustom :: Object
streamMetadataCustom         = Object
forall a. Monoid a => a
mempty
                      }

--------------------------------------------------------------------------------
-- | Maps an 'Object' to a list of 'Pair' to ease the 'StreamMetadata'.
customMetaToPairs :: Object -> [Pair]
customMetaToPairs :: Object -> [Pair]
customMetaToPairs = (Pair -> Pair) -> [Pair] -> [Pair]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Pair -> Pair
forall kv v. (KeyValue kv, ToJSON v) => (Key, v) -> kv
go ([Pair] -> [Pair]) -> (Object -> [Pair]) -> Object -> [Pair]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Object -> [Pair]
forall v. KeyMap v -> [(Key, v)]
KeyMap.toList
  where
    go :: (Key, v) -> kv
go (Key
k,v
v) = Key
k Key -> v -> kv
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= v
v

--------------------------------------------------------------------------------
-- | Gets rid of null-ed properties. If a value is an array and that array only
--   has one element, that function simplifies that array of JSON to a single
--   JSON value.
cleanPairs :: [Pair] -> [Pair]
cleanPairs :: [Pair] -> [Pair]
cleanPairs [Pair]
xs = [Pair]
xs [Pair] -> (Pair -> [Pair]) -> [Pair]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Pair -> [Pair]
forall a. (a, Value) -> [(a, Value)]
go
  where
    go :: (a, Value) -> [(a, Value)]
go (a
_, Value
A.Null) = []
    go (a
name, Value
obj) = [(a
name, Value -> Value
deeper Value
obj)]

    deeper :: Value -> Value
deeper cur :: Value
cur@(A.Array Array
as)
      | Array -> Int
forall a. Vector a -> Int
Vector.length Array
as Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1 = Array -> Value
forall a. Vector a -> a
Vector.head Array
as
      | Bool
otherwise             = Value
cur
    deeper Value
cur = Value
cur

--------------------------------------------------------------------------------
-- | Serialized a 'StreamACL' to 'Value' for serialization purpose.
streamACLJSON :: StreamACL -> A.Value
streamACLJSON :: StreamACL -> Value
streamACLJSON StreamACL{Maybe [Text]
streamACLMetaWriteRoles :: Maybe [Text]
streamACLMetaReadRoles :: Maybe [Text]
streamACLDeleteRoles :: Maybe [Text]
streamACLWriteRoles :: Maybe [Text]
streamACLReadRoles :: Maybe [Text]
streamACLMetaWriteRoles :: StreamACL -> Maybe [Text]
streamACLMetaReadRoles :: StreamACL -> Maybe [Text]
streamACLDeleteRoles :: StreamACL -> Maybe [Text]
streamACLWriteRoles :: StreamACL -> Maybe [Text]
streamACLReadRoles :: StreamACL -> Maybe [Text]
..} =
    [Pair] -> Value
A.object ([Pair] -> Value) -> [Pair] -> Value
forall a b. (a -> b) -> a -> b
$
        [Pair] -> [Pair]
cleanPairs
        [ Key
p_readRoles      Key -> Maybe [Text] -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe [Text]
streamACLReadRoles
        , Key
p_writeRoles     Key -> Maybe [Text] -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe [Text]
streamACLWriteRoles
        , Key
p_deleteRoles    Key -> Maybe [Text] -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe [Text]
streamACLDeleteRoles
        , Key
p_metaReadRoles  Key -> Maybe [Text] -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe [Text]
streamACLMetaReadRoles
        , Key
p_metaWriteRoles Key -> Maybe [Text] -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe [Text]
streamACLMetaWriteRoles
        ]

--------------------------------------------------------------------------------
-- | Serialized a 'StreamMetadata' to 'Value' for serialization purpose.
streamMetadataJSON :: StreamMetadata -> A.Value
streamMetadataJSON :: StreamMetadata -> Value
streamMetadataJSON StreamMetadata{Maybe Int32
Maybe TimeSpan
Maybe StreamACL
Object
streamMetadataCustom :: Object
streamMetadataACL :: Maybe StreamACL
streamMetadataCacheControl :: Maybe TimeSpan
streamMetadataTruncateBefore :: Maybe Int32
streamMetadataMaxAge :: Maybe TimeSpan
streamMetadataMaxCount :: Maybe Int32
streamMetadataCustom :: StreamMetadata -> Object
streamMetadataACL :: StreamMetadata -> Maybe StreamACL
streamMetadataCacheControl :: StreamMetadata -> Maybe TimeSpan
streamMetadataTruncateBefore :: StreamMetadata -> Maybe Int32
streamMetadataMaxAge :: StreamMetadata -> Maybe TimeSpan
streamMetadataMaxCount :: StreamMetadata -> Maybe Int32
..} =
    [Pair] -> Value
A.object ([Pair] -> Value) -> [Pair] -> Value
forall a b. (a -> b) -> a -> b
$
        [Pair] -> [Pair]
cleanPairs
        [ Key
p_maxAge         Key -> Maybe Int64 -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= (TimeSpan -> Int64) -> Maybe TimeSpan -> Maybe Int64
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap TimeSpan -> Int64
toInt64 Maybe TimeSpan
streamMetadataMaxAge
        , Key
p_maxCount       Key -> Maybe Int32 -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Int32
streamMetadataMaxCount
        , Key
p_truncateBefore Key -> Maybe Int32 -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Int32
streamMetadataTruncateBefore
        , Key
p_cacheControl   Key -> Maybe Int64 -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= (TimeSpan -> Int64) -> Maybe TimeSpan -> Maybe Int64
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap TimeSpan -> Int64
toInt64 Maybe TimeSpan
streamMetadataCacheControl
        , Key
p_acl            Key -> Maybe Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= (StreamACL -> Value) -> Maybe StreamACL -> Maybe Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap StreamACL -> Value
streamACLJSON Maybe StreamACL
streamMetadataACL
        ] [Pair] -> [Pair] -> [Pair]
forall a. Semigroup a => a -> a -> a
<> [Pair]
custPairs
  where
    custPairs :: [Pair]
custPairs = Object -> [Pair]
customMetaToPairs Object
streamMetadataCustom

    toInt64 :: TimeSpan -> Int64
    toInt64 :: TimeSpan -> Int64
toInt64 = Double -> Int64
forall a b. (RealFrac a, Integral b) => a -> b
truncate (Double -> Int64) -> (TimeSpan -> Double) -> TimeSpan -> Int64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TimeSpan -> Double
totalSeconds

--------------------------------------------------------------------------------
-- Stream ACL Properties
--------------------------------------------------------------------------------
-- | Read ACL property.
p_readRoles :: A.Key
p_readRoles :: Key
p_readRoles = Key
"$r"

--------------------------------------------------------------------------------
-- | Write ACL property.
p_writeRoles :: A.Key
p_writeRoles :: Key
p_writeRoles = Key
"$w"

--------------------------------------------------------------------------------
-- | Delete ACL property.
p_deleteRoles :: A.Key
p_deleteRoles :: Key
p_deleteRoles = Key
"$d"

--------------------------------------------------------------------------------
-- | Metadata read ACL property.
p_metaReadRoles :: A.Key
p_metaReadRoles :: Key
p_metaReadRoles = Key
"$mr"

--------------------------------------------------------------------------------
-- | Metadata write ACL property.
p_metaWriteRoles :: A.Key
p_metaWriteRoles :: Key
p_metaWriteRoles = Key
"$mw"

--------------------------------------------------------------------------------
-- Internal MetaData Properties
--------------------------------------------------------------------------------
-- | Max age metadata property.
p_maxAge :: A.Key
p_maxAge :: Key
p_maxAge = Key
"$maxAge"

--------------------------------------------------------------------------------
-- | Max count metadata property.
p_maxCount :: A.Key
p_maxCount :: Key
p_maxCount = Key
"$maxCount"

--------------------------------------------------------------------------------
-- | truncated before metadata property.
p_truncateBefore :: A.Key
p_truncateBefore :: Key
p_truncateBefore = Key
"$tb"

--------------------------------------------------------------------------------
-- | Cache control metadata property.
p_cacheControl :: A.Key
p_cacheControl :: Key
p_cacheControl = Key
"$cacheControl"

--------------------------------------------------------------------------------
-- | ACL metadata property.
p_acl :: A.Key
p_acl :: Key
p_acl = Key
"$acl"

--------------------------------------------------------------------------------
-- | Gathers every internal metadata properties into a 'Set'. It used to safely
--   'StreamMetadata' in JSON.
internalMetaProperties :: Set A.Key
internalMetaProperties :: Set Key
internalMetaProperties =
    [Element (Set Key)] -> Set Key
forall set. IsSet set => [Element set] -> set
setFromList [ Key
Element (Set Key)
p_maxAge
                , Key
Element (Set Key)
p_maxCount
                , Key
Element (Set Key)
p_truncateBefore
                , Key
Element (Set Key)
p_cacheControl
                , Key
Element (Set Key)
p_acl
                ]

--------------------------------------------------------------------------------
-- | Only keeps the properties the users has set.
keepUserProperties :: Object -> Object
keepUserProperties :: Object -> Object
keepUserProperties = (Key -> Value -> Bool) -> Object -> Object
forall v. (Key -> v -> Bool) -> KeyMap v -> KeyMap v
KeyMap.filterWithKey Key -> Value -> Bool
forall p. Key -> p -> Bool
go
  where
    go :: Key -> p -> Bool
go Key
k p
_ = ContainerKey (Set Key) -> Set Key -> Bool
forall set. SetContainer set => ContainerKey set -> set -> Bool
notMember Key
ContainerKey (Set Key)
k Set Key
internalMetaProperties

--------------------------------------------------------------------------------
-- | Parses a 'NominalDiffTime' from an 'Object' given a JSON property.
parseNominalDiffTime :: A.Key -> Object -> Parser (Maybe NominalDiffTime)
parseNominalDiffTime :: Key -> Object -> Parser (Maybe POSIXTime)
parseNominalDiffTime Key
k Object
m = (Maybe Int64 -> Maybe POSIXTime)
-> Parser (Maybe Int64) -> Parser (Maybe POSIXTime)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Int64 -> POSIXTime) -> Maybe Int64 -> Maybe POSIXTime
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Int64 -> POSIXTime
forall b. Fractional b => Int64 -> b
go) (Object
m Object -> Key -> Parser (Maybe Int64)
forall a. FromJSON a => Object -> Key -> Parser a
A..: Key
k)
  where
    go :: Int64 -> b
go Int64
n = (CTime -> b
forall a b. (Real a, Fractional b) => a -> b
realToFrac (CTime -> b) -> CTime -> b
forall a b. (a -> b) -> a -> b
$ Int64 -> CTime
CTime Int64
n)

--------------------------------------------------------------------------------
-- | Parses 'StreamACL'.
parseStreamACL :: A.Value -> Parser StreamACL
parseStreamACL :: Value -> Parser StreamACL
parseStreamACL (A.Object Object
m) =
    Maybe [Text]
-> Maybe [Text]
-> Maybe [Text]
-> Maybe [Text]
-> Maybe [Text]
-> StreamACL
StreamACL
        (Maybe [Text]
 -> Maybe [Text]
 -> Maybe [Text]
 -> Maybe [Text]
 -> Maybe [Text]
 -> StreamACL)
-> Parser (Maybe [Text])
-> Parser
     (Maybe [Text]
      -> Maybe [Text] -> Maybe [Text] -> Maybe [Text] -> StreamACL)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object -> Key -> Parser (Maybe [Text])
parseSingleOrMultiple Object
m Key
p_readRoles
        Parser
  (Maybe [Text]
   -> Maybe [Text] -> Maybe [Text] -> Maybe [Text] -> StreamACL)
-> Parser (Maybe [Text])
-> Parser
     (Maybe [Text] -> Maybe [Text] -> Maybe [Text] -> StreamACL)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object -> Key -> Parser (Maybe [Text])
parseSingleOrMultiple Object
m Key
p_writeRoles
        Parser (Maybe [Text] -> Maybe [Text] -> Maybe [Text] -> StreamACL)
-> Parser (Maybe [Text])
-> Parser (Maybe [Text] -> Maybe [Text] -> StreamACL)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object -> Key -> Parser (Maybe [Text])
parseSingleOrMultiple Object
m Key
p_deleteRoles
        Parser (Maybe [Text] -> Maybe [Text] -> StreamACL)
-> Parser (Maybe [Text]) -> Parser (Maybe [Text] -> StreamACL)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object -> Key -> Parser (Maybe [Text])
parseSingleOrMultiple Object
m Key
p_metaReadRoles
        Parser (Maybe [Text] -> StreamACL)
-> Parser (Maybe [Text]) -> Parser StreamACL
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object -> Key -> Parser (Maybe [Text])
parseSingleOrMultiple Object
m Key
p_metaWriteRoles
parseStreamACL Value
_ = Parser StreamACL
forall (m :: * -> *) a. MonadPlus m => m a
mzero

--------------------------------------------------------------------------------
parseSingleOrMultiple :: A.Object -> A.Key -> Parser (Maybe [Text])
parseSingleOrMultiple :: Object -> Key -> Parser (Maybe [Text])
parseSingleOrMultiple Object
obj Key
name = Parser (Maybe [Text])
multiple Parser (Maybe [Text])
-> Parser (Maybe [Text]) -> Parser (Maybe [Text])
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser (Maybe [Text])
single
  where
    single :: Parser (Maybe [Text])
single = do
        Maybe Text
mV <- Object
obj Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser a
A..: Key
name Parser (Maybe Text) -> Parser (Maybe Text) -> Parser (Maybe Text)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe Text -> Parser (Maybe Text)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe Text
forall a. Maybe a
Nothing
        Maybe [Text] -> Parser (Maybe [Text])
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe [Text] -> Parser (Maybe [Text]))
-> Maybe [Text] -> Parser (Maybe [Text])
forall a b. (a -> b) -> a -> b
$ (Text -> [Text]) -> Maybe Text -> Maybe [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\Text
v -> [Text
v]) Maybe Text
mV

    multiple :: Parser (Maybe [Text])
multiple = Object
obj Object -> Key -> Parser (Maybe [Text])
forall a. FromJSON a => Object -> Key -> Parser a
A..: Key
name

--------------------------------------------------------------------------------
-- | Parses 'StreamMetadata'.
parseStreamMetadata :: A.Value -> Parser StreamMetadata
parseStreamMetadata :: Value -> Parser StreamMetadata
parseStreamMetadata (A.Object Object
m) =
    Maybe Int32
-> Maybe TimeSpan
-> Maybe Int32
-> Maybe TimeSpan
-> Maybe StreamACL
-> Object
-> StreamMetadata
StreamMetadata
        (Maybe Int32
 -> Maybe TimeSpan
 -> Maybe Int32
 -> Maybe TimeSpan
 -> Maybe StreamACL
 -> Object
 -> StreamMetadata)
-> Parser (Maybe Int32)
-> Parser
     (Maybe TimeSpan
      -> Maybe Int32
      -> Maybe TimeSpan
      -> Maybe StreamACL
      -> Object
      -> StreamMetadata)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
m Object -> Key -> Parser (Maybe Int32)
forall a. FromJSON a => Object -> Key -> Parser a
A..: Key
p_maxCount Parser (Maybe Int32)
-> Parser (Maybe Int32) -> Parser (Maybe Int32)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe Int32 -> Parser (Maybe Int32)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe Int32
forall a. Maybe a
Nothing)
        Parser
  (Maybe TimeSpan
   -> Maybe Int32
   -> Maybe TimeSpan
   -> Maybe StreamACL
   -> Object
   -> StreamMetadata)
-> Parser (Maybe TimeSpan)
-> Parser
     (Maybe Int32
      -> Maybe TimeSpan -> Maybe StreamACL -> Object -> StreamMetadata)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Key -> Parser (Maybe TimeSpan)
parseTimeSpan Key
p_maxAge Parser (Maybe TimeSpan)
-> Parser (Maybe TimeSpan) -> Parser (Maybe TimeSpan)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe TimeSpan -> Parser (Maybe TimeSpan)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe TimeSpan
forall a. Maybe a
Nothing)
        Parser
  (Maybe Int32
   -> Maybe TimeSpan -> Maybe StreamACL -> Object -> StreamMetadata)
-> Parser (Maybe Int32)
-> Parser
     (Maybe TimeSpan -> Maybe StreamACL -> Object -> StreamMetadata)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
m Object -> Key -> Parser (Maybe Int32)
forall a. FromJSON a => Object -> Key -> Parser a
A..: Key
p_truncateBefore Parser (Maybe Int32)
-> Parser (Maybe Int32) -> Parser (Maybe Int32)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe Int32 -> Parser (Maybe Int32)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe Int32
forall a. Maybe a
Nothing)
        Parser
  (Maybe TimeSpan -> Maybe StreamACL -> Object -> StreamMetadata)
-> Parser (Maybe TimeSpan)
-> Parser (Maybe StreamACL -> Object -> StreamMetadata)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Key -> Parser (Maybe TimeSpan)
parseTimeSpan Key
p_cacheControl Parser (Maybe TimeSpan)
-> Parser (Maybe TimeSpan) -> Parser (Maybe TimeSpan)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe TimeSpan -> Parser (Maybe TimeSpan)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe TimeSpan
forall a. Maybe a
Nothing)
        Parser (Maybe StreamACL -> Object -> StreamMetadata)
-> Parser (Maybe StreamACL) -> Parser (Object -> StreamMetadata)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ((Object
m Object -> Key -> Parser (Maybe Value)
forall a. FromJSON a => Object -> Key -> Parser a
A..: Key
p_acl Parser (Maybe Value)
-> (Maybe Value -> Parser (Maybe StreamACL))
-> Parser (Maybe StreamACL)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Value -> Parser StreamACL)
-> Maybe Value -> Parser (Maybe StreamACL)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse Value -> Parser StreamACL
parseStreamACL) Parser (Maybe StreamACL)
-> Parser (Maybe StreamACL) -> Parser (Maybe StreamACL)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe StreamACL -> Parser (Maybe StreamACL)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe StreamACL
forall a. Maybe a
Nothing)
        Parser (Object -> StreamMetadata)
-> Parser Object -> Parser StreamMetadata
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object -> Parser Object
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Object -> Object
keepUserProperties Object
m)
  where
    parseTimeSpan ::  A.Key -> Parser (Maybe TimeSpan)
    parseTimeSpan :: Key -> Parser (Maybe TimeSpan)
parseTimeSpan Key
prop = do
        (Maybe Int64
secs :: Maybe Int64) <- Object
m Object -> Key -> Parser (Maybe Int64)
forall a. FromJSON a => Object -> Key -> Parser a
A..: Key
prop
        Maybe TimeSpan -> Parser (Maybe TimeSpan)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe TimeSpan -> Parser (Maybe TimeSpan))
-> Maybe TimeSpan -> Parser (Maybe TimeSpan)
forall a b. (a -> b) -> a -> b
$ (Int64 -> TimeSpan) -> Maybe Int64 -> Maybe TimeSpan
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Double -> TimeSpan
fromSeconds (Double -> TimeSpan) -> (Int64 -> Double) -> Int64 -> TimeSpan
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int64 -> Double
forall a b. (Real a, Fractional b) => a -> b
realToFrac) Maybe Int64
secs
parseStreamMetadata Value
_ = Parser StreamMetadata
forall (m :: * -> *) a. MonadPlus m => m a
mzero

--------------------------------------------------------------------------------
-- Builder
--------------------------------------------------------------------------------
-- | Allows to build a structure using 'Monoid' functions.
type Builder a = Endo a

--------------------------------------------------------------------------------
-- | Build a structure given a 'Builder' and an initial value.
build :: a -> Builder a -> a
build :: a -> Builder a -> a
build a
a (Endo a -> a
k) = a -> a
k a
a

--------------------------------------------------------------------------------
-- | A 'Builder' applies to 'StreamACL'.
type StreamACLBuilder = Builder StreamACL

--------------------------------------------------------------------------------
-- | Sets role names with read permission for the stream.
setReadRoles :: [Text] -> StreamACLBuilder
setReadRoles :: [Text] -> StreamACLBuilder
setReadRoles [Text]
xs = (StreamACL -> StreamACL) -> StreamACLBuilder
forall a. (a -> a) -> Endo a
Endo ((StreamACL -> StreamACL) -> StreamACLBuilder)
-> (StreamACL -> StreamACL) -> StreamACLBuilder
forall a b. (a -> b) -> a -> b
$ \StreamACL
s -> StreamACL
s { streamACLReadRoles :: Maybe [Text]
streamACLReadRoles = [Text] -> Maybe [Text]
forall a. a -> Maybe a
Just [Text]
xs }

--------------------------------------------------------------------------------
-- | Sets a single role name with read permission for the stream.
setReadRole :: Text -> StreamACLBuilder
setReadRole :: Text -> StreamACLBuilder
setReadRole Text
x = [Text] -> StreamACLBuilder
setReadRoles [Text
x]

--------------------------------------------------------------------------------
-- | Sets role names with write permission for the stream.
setWriteRoles :: [Text] -> StreamACLBuilder
setWriteRoles :: [Text] -> StreamACLBuilder
setWriteRoles [Text]
xs = (StreamACL -> StreamACL) -> StreamACLBuilder
forall a. (a -> a) -> Endo a
Endo ((StreamACL -> StreamACL) -> StreamACLBuilder)
-> (StreamACL -> StreamACL) -> StreamACLBuilder
forall a b. (a -> b) -> a -> b
$ \StreamACL
s -> StreamACL
s { streamACLWriteRoles :: Maybe [Text]
streamACLWriteRoles = [Text] -> Maybe [Text]
forall a. a -> Maybe a
Just [Text]
xs }

--------------------------------------------------------------------------------
-- | Sets a single role name with write permission for the stream.
setWriteRole :: Text -> StreamACLBuilder
setWriteRole :: Text -> StreamACLBuilder
setWriteRole Text
x = [Text] -> StreamACLBuilder
setWriteRoles [Text
x]

--------------------------------------------------------------------------------
-- | Sets role names with delete permission for the stream.
setDeleteRoles :: [Text] -> StreamACLBuilder
setDeleteRoles :: [Text] -> StreamACLBuilder
setDeleteRoles [Text]
xs = (StreamACL -> StreamACL) -> StreamACLBuilder
forall a. (a -> a) -> Endo a
Endo ((StreamACL -> StreamACL) -> StreamACLBuilder)
-> (StreamACL -> StreamACL) -> StreamACLBuilder
forall a b. (a -> b) -> a -> b
$ \StreamACL
s -> StreamACL
s { streamACLDeleteRoles :: Maybe [Text]
streamACLDeleteRoles = [Text] -> Maybe [Text]
forall a. a -> Maybe a
Just [Text]
xs }

--------------------------------------------------------------------------------
-- | Sets a single role name with delete permission for the stream.
setDeleteRole :: Text -> StreamACLBuilder
setDeleteRole :: Text -> StreamACLBuilder
setDeleteRole Text
x = [Text] -> StreamACLBuilder
setDeleteRoles [Text
x]

--------------------------------------------------------------------------------
-- | Sets role names with metadata read permission for the stream.
setMetaReadRoles :: [Text] -> StreamACLBuilder
setMetaReadRoles :: [Text] -> StreamACLBuilder
setMetaReadRoles [Text]
xs = (StreamACL -> StreamACL) -> StreamACLBuilder
forall a. (a -> a) -> Endo a
Endo ((StreamACL -> StreamACL) -> StreamACLBuilder)
-> (StreamACL -> StreamACL) -> StreamACLBuilder
forall a b. (a -> b) -> a -> b
$ \StreamACL
s -> StreamACL
s { streamACLMetaReadRoles :: Maybe [Text]
streamACLMetaReadRoles = [Text] -> Maybe [Text]
forall a. a -> Maybe a
Just [Text]
xs }

--------------------------------------------------------------------------------
-- | Sets a single role name with metadata read permission for the stream.
setMetaReadRole :: Text -> StreamACLBuilder
setMetaReadRole :: Text -> StreamACLBuilder
setMetaReadRole Text
x = [Text] -> StreamACLBuilder
setMetaReadRoles [Text
x]

--------------------------------------------------------------------------------
-- | Sets role names with metadata write permission for the stream.
setMetaWriteRoles :: [Text] -> StreamACLBuilder
setMetaWriteRoles :: [Text] -> StreamACLBuilder
setMetaWriteRoles [Text]
xs = (StreamACL -> StreamACL) -> StreamACLBuilder
forall a. (a -> a) -> Endo a
Endo ((StreamACL -> StreamACL) -> StreamACLBuilder)
-> (StreamACL -> StreamACL) -> StreamACLBuilder
forall a b. (a -> b) -> a -> b
$ \StreamACL
s -> StreamACL
s { streamACLMetaWriteRoles :: Maybe [Text]
streamACLMetaWriteRoles = [Text] -> Maybe [Text]
forall a. a -> Maybe a
Just [Text]
xs }

--------------------------------------------------------------------------------
-- | Sets a single role name with metadata write permission for the stream.
setMetaWriteRole :: Text -> StreamACLBuilder
setMetaWriteRole :: Text -> StreamACLBuilder
setMetaWriteRole Text
x = [Text] -> StreamACLBuilder
setMetaWriteRoles [Text
x]

--------------------------------------------------------------------------------
-- | Builds a 'StreamACL' from a 'StreamACLBuilder'.
buildStreamACL :: StreamACLBuilder -> StreamACL
buildStreamACL :: StreamACLBuilder -> StreamACL
buildStreamACL StreamACLBuilder
b = StreamACLBuilder -> StreamACL -> StreamACL
modifyStreamACL StreamACLBuilder
b StreamACL
emptyStreamACL

--------------------------------------------------------------------------------
-- | Modifies a 'StreamACL' using a 'StreamACLBuilder'.
modifyStreamACL :: StreamACLBuilder -> StreamACL -> StreamACL
modifyStreamACL :: StreamACLBuilder -> StreamACL -> StreamACL
modifyStreamACL StreamACLBuilder
b StreamACL
acl = StreamACL -> StreamACLBuilder -> StreamACL
forall a. a -> Builder a -> a
build StreamACL
acl StreamACLBuilder
b

--------------------------------------------------------------------------------
-- | A 'Builder' applies to 'StreamMetadata'.
type StreamMetadataBuilder = Builder StreamMetadata

--------------------------------------------------------------------------------
-- | Sets the maximum number of events allowed in the stream.
setMaxCount :: Int32 -> StreamMetadataBuilder
setMaxCount :: Int32 -> StreamMetadataBuilder
setMaxCount Int32
n = (StreamMetadata -> StreamMetadata) -> StreamMetadataBuilder
forall a. (a -> a) -> Endo a
Endo ((StreamMetadata -> StreamMetadata) -> StreamMetadataBuilder)
-> (StreamMetadata -> StreamMetadata) -> StreamMetadataBuilder
forall a b. (a -> b) -> a -> b
$ \StreamMetadata
s -> StreamMetadata
s { streamMetadataMaxCount :: Maybe Int32
streamMetadataMaxCount = Int32 -> Maybe Int32
forall a. a -> Maybe a
Just Int32
n }

--------------------------------------------------------------------------------
-- | Sets the maximum age of events allowed in the stream.
setMaxAge :: TimeSpan -> StreamMetadataBuilder
setMaxAge :: TimeSpan -> StreamMetadataBuilder
setMaxAge TimeSpan
d = (StreamMetadata -> StreamMetadata) -> StreamMetadataBuilder
forall a. (a -> a) -> Endo a
Endo ((StreamMetadata -> StreamMetadata) -> StreamMetadataBuilder)
-> (StreamMetadata -> StreamMetadata) -> StreamMetadataBuilder
forall a b. (a -> b) -> a -> b
$ \StreamMetadata
s -> StreamMetadata
s { streamMetadataMaxAge :: Maybe TimeSpan
streamMetadataMaxAge = TimeSpan -> Maybe TimeSpan
forall a. a -> Maybe a
Just TimeSpan
d }

--------------------------------------------------------------------------------
-- | Sets the event number from which previous events can be scavenged.
setTruncateBefore :: Int32 -> StreamMetadataBuilder
setTruncateBefore :: Int32 -> StreamMetadataBuilder
setTruncateBefore Int32
n = (StreamMetadata -> StreamMetadata) -> StreamMetadataBuilder
forall a. (a -> a) -> Endo a
Endo ((StreamMetadata -> StreamMetadata) -> StreamMetadataBuilder)
-> (StreamMetadata -> StreamMetadata) -> StreamMetadataBuilder
forall a b. (a -> b) -> a -> b
$ \StreamMetadata
s -> StreamMetadata
s { streamMetadataTruncateBefore :: Maybe Int32
streamMetadataTruncateBefore = Int32 -> Maybe Int32
forall a. a -> Maybe a
Just Int32
n }

--------------------------------------------------------------------------------
-- | Sets the amount of time for which the stream head is cachable.
setCacheControl :: TimeSpan -> StreamMetadataBuilder
setCacheControl :: TimeSpan -> StreamMetadataBuilder
setCacheControl TimeSpan
d = (StreamMetadata -> StreamMetadata) -> StreamMetadataBuilder
forall a. (a -> a) -> Endo a
Endo ((StreamMetadata -> StreamMetadata) -> StreamMetadataBuilder)
-> (StreamMetadata -> StreamMetadata) -> StreamMetadataBuilder
forall a b. (a -> b) -> a -> b
$ \StreamMetadata
s -> StreamMetadata
s { streamMetadataCacheControl :: Maybe TimeSpan
streamMetadataCacheControl = TimeSpan -> Maybe TimeSpan
forall a. a -> Maybe a
Just TimeSpan
d }

--------------------------------------------------------------------------------
-- | Overwrites any previous 'StreamACL' by the given one in a
--   'StreamMetadataBuilder'.
setACL :: StreamACL -> StreamMetadataBuilder
setACL :: StreamACL -> StreamMetadataBuilder
setACL StreamACL
a = (StreamMetadata -> StreamMetadata) -> StreamMetadataBuilder
forall a. (a -> a) -> Endo a
Endo ((StreamMetadata -> StreamMetadata) -> StreamMetadataBuilder)
-> (StreamMetadata -> StreamMetadata) -> StreamMetadataBuilder
forall a b. (a -> b) -> a -> b
$ \StreamMetadata
s -> StreamMetadata
s { streamMetadataACL :: Maybe StreamACL
streamMetadataACL = StreamACL -> Maybe StreamACL
forall a. a -> Maybe a
Just StreamACL
a }

--------------------------------------------------------------------------------
-- | Updates a 'StreamMetadata''s 'StreamACL' given a 'StreamACLBuilder'.
modifyACL :: StreamACLBuilder -> StreamMetadataBuilder
modifyACL :: StreamACLBuilder -> StreamMetadataBuilder
modifyACL StreamACLBuilder
b = (StreamMetadata -> StreamMetadata) -> StreamMetadataBuilder
forall a. (a -> a) -> Endo a
Endo ((StreamMetadata -> StreamMetadata) -> StreamMetadataBuilder)
-> (StreamMetadata -> StreamMetadata) -> StreamMetadataBuilder
forall a b. (a -> b) -> a -> b
$ \StreamMetadata
s ->
    let old :: StreamACL
old = StreamACL -> Maybe StreamACL -> StreamACL
forall a. a -> Maybe a -> a
fromMaybe StreamACL
emptyStreamACL (Maybe StreamACL -> StreamACL) -> Maybe StreamACL -> StreamACL
forall a b. (a -> b) -> a -> b
$ StreamMetadata -> Maybe StreamACL
streamMetadataACL StreamMetadata
s
    in StreamMetadata
s { streamMetadataACL :: Maybe StreamACL
streamMetadataACL = StreamACL -> Maybe StreamACL
forall a. a -> Maybe a
Just (StreamACL -> Maybe StreamACL) -> StreamACL -> Maybe StreamACL
forall a b. (a -> b) -> a -> b
$ StreamACLBuilder -> StreamACL -> StreamACL
modifyStreamACL StreamACLBuilder
b StreamACL
old }

--------------------------------------------------------------------------------
-- | Sets a custom metadata property.
setCustomProperty :: ToJSON a => A.Key -> a -> StreamMetadataBuilder
setCustomProperty :: Key -> a -> StreamMetadataBuilder
setCustomProperty Key
k a
v = (StreamMetadata -> StreamMetadata) -> StreamMetadataBuilder
forall a. (a -> a) -> Endo a
Endo ((StreamMetadata -> StreamMetadata) -> StreamMetadataBuilder)
-> (StreamMetadata -> StreamMetadata) -> StreamMetadataBuilder
forall a b. (a -> b) -> a -> b
$ \StreamMetadata
s ->
    let m :: Object
m  = StreamMetadata -> Object
streamMetadataCustom StreamMetadata
s
        m' :: Object
m' = Key -> Value -> Object -> Object
forall v. Key -> v -> KeyMap v -> KeyMap v
KeyMap.insert Key
k (a -> Value
forall a. ToJSON a => a -> Value
toJSON a
v) Object
m in
     StreamMetadata
s { streamMetadataCustom :: Object
streamMetadataCustom = Object
m' }

--------------------------------------------------------------------------------
-- | Builds a 'StreamMetadata' from a 'StreamMetadataBuilder'.
buildStreamMetadata :: StreamMetadataBuilder -> StreamMetadata
buildStreamMetadata :: StreamMetadataBuilder -> StreamMetadata
buildStreamMetadata StreamMetadataBuilder
b = StreamMetadataBuilder -> StreamMetadata -> StreamMetadata
modifyStreamMetadata StreamMetadataBuilder
b StreamMetadata
emptyStreamMetadata

--------------------------------------------------------------------------------
-- | Modifies a 'StreamMetadata' using a 'StreamMetadataBuilder'
modifyStreamMetadata :: StreamMetadataBuilder
                     -> StreamMetadata
                     -> StreamMetadata
modifyStreamMetadata :: StreamMetadataBuilder -> StreamMetadata -> StreamMetadata
modifyStreamMetadata StreamMetadataBuilder
b StreamMetadata
meta = StreamMetadata -> StreamMetadataBuilder -> StreamMetadata
forall a. a -> Builder a -> a
build StreamMetadata
meta StreamMetadataBuilder
b

--------------------------------------------------------------------------------
-- | Represents stream metadata as a series of properties for system data and a
--   'StreamMetadata' object for user metadata.
data StreamMetadataResult
    = StreamMetadataResult
      { StreamMetadataResult -> Text
streamMetaResultStream :: !Text
        -- ^ The name of the stream.
      , StreamMetadataResult -> Int64
streamMetaResultVersion :: !Int64
        -- ^ The version of the metadata format.
      , StreamMetadataResult -> StreamMetadata
streamMetaResultData :: !StreamMetadata
        -- ^ A 'StreamMetadata' containing user-specified metadata.
      }
    | NotFoundStreamMetadataResult { streamMetaResultStream :: !Text }
      -- ^ When the stream is either not found or 'no stream'.
    | DeletedStreamMetadataResult { streamMetaResultStream :: !Text }
      -- ^ When the stream is soft-deleted.
    deriving Int -> StreamMetadataResult -> ShowS
[StreamMetadataResult] -> ShowS
StreamMetadataResult -> String
(Int -> StreamMetadataResult -> ShowS)
-> (StreamMetadataResult -> String)
-> ([StreamMetadataResult] -> ShowS)
-> Show StreamMetadataResult
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [StreamMetadataResult] -> ShowS
$cshowList :: [StreamMetadataResult] -> ShowS
show :: StreamMetadataResult -> String
$cshow :: StreamMetadataResult -> String
showsPrec :: Int -> StreamMetadataResult -> ShowS
$cshowsPrec :: Int -> StreamMetadataResult -> ShowS
Show

--------------------------------------------------------------------------------
-- | System supported consumer strategies for use with persistent subscriptions.
data SystemConsumerStrategy
    = DispatchToSingle
      -- ^ Distributes events to a single client until the bufferSize is reached.
      --   After which the next client is selected in a round robin style,
      --   and the process is repeated.
    | RoundRobin
      -- ^ Distributes events to all clients evenly. If the client buffer-size
      --   is reached the client is ignored until events are
      --   acknowledged/not acknowledged.
    | Pinned
      -- ^ For use with an indexing projection such as the system $by_category
      --   projection. Event Store inspects event for its source stream id,
      --   hashing the id to one of 1024 buckets assigned to individual clients.
      --   When a client disconnects it's buckets are assigned to other clients.
      --   When a client connects, it is assigned some of the existing buckets.
      --   This naively attempts to maintain a balanced workload.
      --   The main aim of this strategy is to decrease the likelihood of
      --   concurrency and ordering issues while maintaining load balancing.
      --   This is not a guarantee, and you should handle the usual ordering
      --   and concurrency issues.
    deriving (Int -> SystemConsumerStrategy -> ShowS
[SystemConsumerStrategy] -> ShowS
SystemConsumerStrategy -> String
(Int -> SystemConsumerStrategy -> ShowS)
-> (SystemConsumerStrategy -> String)
-> ([SystemConsumerStrategy] -> ShowS)
-> Show SystemConsumerStrategy
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SystemConsumerStrategy] -> ShowS
$cshowList :: [SystemConsumerStrategy] -> ShowS
show :: SystemConsumerStrategy -> String
$cshow :: SystemConsumerStrategy -> String
showsPrec :: Int -> SystemConsumerStrategy -> ShowS
$cshowsPrec :: Int -> SystemConsumerStrategy -> ShowS
Show, SystemConsumerStrategy -> SystemConsumerStrategy -> Bool
(SystemConsumerStrategy -> SystemConsumerStrategy -> Bool)
-> (SystemConsumerStrategy -> SystemConsumerStrategy -> Bool)
-> Eq SystemConsumerStrategy
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SystemConsumerStrategy -> SystemConsumerStrategy -> Bool
$c/= :: SystemConsumerStrategy -> SystemConsumerStrategy -> Bool
== :: SystemConsumerStrategy -> SystemConsumerStrategy -> Bool
$c== :: SystemConsumerStrategy -> SystemConsumerStrategy -> Bool
Eq)

--------------------------------------------------------------------------------
-- | Maps a 'SystemConsumerStrategy' to a 'Text' understandable by the server.
strategyText :: SystemConsumerStrategy -> Text
strategyText :: SystemConsumerStrategy -> Text
strategyText SystemConsumerStrategy
DispatchToSingle = Text
"DispatchToSingle"
strategyText SystemConsumerStrategy
RoundRobin       = Text
"RoundRobin"
strategyText SystemConsumerStrategy
Pinned           = Text
"Pinned"

--------------------------------------------------------------------------------
-- | Tries to parse a 'SystemConsumerStrategy' given a raw 'Text'.
strategyFromText :: Text -> Maybe SystemConsumerStrategy
strategyFromText :: Text -> Maybe SystemConsumerStrategy
strategyFromText Text
"DispatchToSingle" = SystemConsumerStrategy -> Maybe SystemConsumerStrategy
forall a. a -> Maybe a
Just SystemConsumerStrategy
DispatchToSingle
strategyFromText Text
"RoundRobin"       = SystemConsumerStrategy -> Maybe SystemConsumerStrategy
forall a. a -> Maybe a
Just SystemConsumerStrategy
RoundRobin
strategyFromText Text
"Pinned"           = SystemConsumerStrategy -> Maybe SystemConsumerStrategy
forall a. a -> Maybe a
Just SystemConsumerStrategy
Pinned
strategyFromText Text
_                  = Maybe SystemConsumerStrategy
forall a. Maybe a
Nothing

--------------------------------------------------------------------------------
-- | Gathers every persistent subscription property.
data PersistentSubscriptionSettings =
    PersistentSubscriptionSettings
    { PersistentSubscriptionSettings -> Bool
psSettingsResolveLinkTos :: !Bool
      -- ^ Whether or not the persistent subscription should resolve linkTo
      --   events to their linked events.
    , PersistentSubscriptionSettings -> Int64
psSettingsStartFrom :: !Int64
      -- ^ Where the subscription should start from (position).
    , PersistentSubscriptionSettings -> Bool
psSettingsExtraStats :: !Bool
      -- ^ Whether or not in depth latency statistics should be tracked on this
      --   subscription.
    , PersistentSubscriptionSettings -> TimeSpan
psSettingsMsgTimeout :: !TimeSpan
      -- ^ The amount of time after which a message should be considered to be
      --   timeout and retried.
    , PersistentSubscriptionSettings -> Int32
psSettingsMaxRetryCount :: !Int32
      -- ^ The maximum number of retries (due to timeout) before a message get
      --   considered to be parked.
    , PersistentSubscriptionSettings -> Int32
psSettingsLiveBufSize :: !Int32
      -- ^ The size of the buffer listening to live messages as they happen.
    , PersistentSubscriptionSettings -> Int32
psSettingsReadBatchSize :: !Int32
      -- ^ The number of events read at a time when paging in history.
    , PersistentSubscriptionSettings -> Int32
psSettingsHistoryBufSize :: !Int32
      -- ^ The number  of events to cache when paging through history.
    , PersistentSubscriptionSettings -> TimeSpan
psSettingsCheckPointAfter :: !TimeSpan
      -- ^ The amount of time to try checkpoint after.
    , PersistentSubscriptionSettings -> Int32
psSettingsMinCheckPointCount :: !Int32
      -- ^ The minimum number of messages to checkpoint.
    , PersistentSubscriptionSettings -> Int32
psSettingsMaxCheckPointCount :: !Int32
      -- ^ The maximum number of message to checkpoint. If this number is
      --   reached, a checkpoint will be forced.
    , PersistentSubscriptionSettings -> Int32
psSettingsMaxSubsCount :: !Int32
      -- ^ The maximum number of subscribers allowed.
    , PersistentSubscriptionSettings -> SystemConsumerStrategy
psSettingsNamedConsumerStrategy :: !SystemConsumerStrategy
      -- ^ The strategy to use for distributing events to client consumers.
    } deriving (Int -> PersistentSubscriptionSettings -> ShowS
[PersistentSubscriptionSettings] -> ShowS
PersistentSubscriptionSettings -> String
(Int -> PersistentSubscriptionSettings -> ShowS)
-> (PersistentSubscriptionSettings -> String)
-> ([PersistentSubscriptionSettings] -> ShowS)
-> Show PersistentSubscriptionSettings
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PersistentSubscriptionSettings] -> ShowS
$cshowList :: [PersistentSubscriptionSettings] -> ShowS
show :: PersistentSubscriptionSettings -> String
$cshow :: PersistentSubscriptionSettings -> String
showsPrec :: Int -> PersistentSubscriptionSettings -> ShowS
$cshowsPrec :: Int -> PersistentSubscriptionSettings -> ShowS
Show, PersistentSubscriptionSettings
-> PersistentSubscriptionSettings -> Bool
(PersistentSubscriptionSettings
 -> PersistentSubscriptionSettings -> Bool)
-> (PersistentSubscriptionSettings
    -> PersistentSubscriptionSettings -> Bool)
-> Eq PersistentSubscriptionSettings
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PersistentSubscriptionSettings
-> PersistentSubscriptionSettings -> Bool
$c/= :: PersistentSubscriptionSettings
-> PersistentSubscriptionSettings -> Bool
== :: PersistentSubscriptionSettings
-> PersistentSubscriptionSettings -> Bool
$c== :: PersistentSubscriptionSettings
-> PersistentSubscriptionSettings -> Bool
Eq)

--------------------------------------------------------------------------------
-- | System default persistent subscription settings.
defaultPersistentSubscriptionSettings :: PersistentSubscriptionSettings
defaultPersistentSubscriptionSettings :: PersistentSubscriptionSettings
defaultPersistentSubscriptionSettings =
    PersistentSubscriptionSettings :: Bool
-> Int64
-> Bool
-> TimeSpan
-> Int32
-> Int32
-> Int32
-> Int32
-> TimeSpan
-> Int32
-> Int32
-> Int32
-> SystemConsumerStrategy
-> PersistentSubscriptionSettings
PersistentSubscriptionSettings
    { psSettingsResolveLinkTos :: Bool
psSettingsResolveLinkTos        = Bool
False
    , psSettingsStartFrom :: Int64
psSettingsStartFrom             = (-Int64
1)
    , psSettingsExtraStats :: Bool
psSettingsExtraStats            = Bool
False
    , psSettingsMsgTimeout :: TimeSpan
psSettingsMsgTimeout            = Double -> TimeSpan
fromSeconds Double
30
    , psSettingsMaxRetryCount :: Int32
psSettingsMaxRetryCount         = Int32
500
    , psSettingsLiveBufSize :: Int32
psSettingsLiveBufSize           = Int32
500
    , psSettingsReadBatchSize :: Int32
psSettingsReadBatchSize         = Int32
10
    , psSettingsHistoryBufSize :: Int32
psSettingsHistoryBufSize        = Int32
20
    , psSettingsCheckPointAfter :: TimeSpan
psSettingsCheckPointAfter       = Double -> TimeSpan
fromSeconds Double
2
    , psSettingsMinCheckPointCount :: Int32
psSettingsMinCheckPointCount    = Int32
10
    , psSettingsMaxCheckPointCount :: Int32
psSettingsMaxCheckPointCount    = Int32
1000
    , psSettingsMaxSubsCount :: Int32
psSettingsMaxSubsCount          = Int32
0
    , psSettingsNamedConsumerStrategy :: SystemConsumerStrategy
psSettingsNamedConsumerStrategy = SystemConsumerStrategy
RoundRobin
    }

--------------------------------------------------------------------------------
newtype Duration = Duration Int64 deriving Int -> Duration -> ShowS
[Duration] -> ShowS
Duration -> String
(Int -> Duration -> ShowS)
-> (Duration -> String) -> ([Duration] -> ShowS) -> Show Duration
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Duration] -> ShowS
$cshowList :: [Duration] -> ShowS
show :: Duration -> String
$cshow :: Duration -> String
showsPrec :: Int -> Duration -> ShowS
$cshowsPrec :: Int -> Duration -> ShowS
Show

--------------------------------------------------------------------------------
msDuration :: Int64 -> Duration
msDuration :: Int64 -> Duration
msDuration = Int64 -> Duration
Duration (Int64 -> Duration) -> (Int64 -> Int64) -> Int64 -> Duration
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int64
1000 Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
*)

--------------------------------------------------------------------------------
secsDuration :: Int64 -> Duration
secsDuration :: Int64 -> Duration
secsDuration = Int64 -> Duration
msDuration (Int64 -> Duration) -> (Int64 -> Int64) -> Int64 -> Duration
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int64
1000 Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
*)