module MessageDb.Message
  ( MessageId (..)
  , newMessageId
  , MessageType (..)
  , messageTypeOf
  , StreamPosition (..)
  , GlobalPosition (..)
  , CreatedAt (..)
  , Payload (..)
  , nullPayload
  , parsePayload
  , Metadata (..)
  , nullMetadata
  , parseMetadata
  , Message (..)
  , ParseMessageFailure (..)
  , ParsedMessage (..)
  , parseMessage
  )
where

import Control.Exception (Exception)
import Data.Aeson ((.!=), (.:), (.:?), (.=))
import qualified Data.Aeson as Aeson
import qualified Data.Aeson.Types as AesonTypes
import qualified Data.ByteString.Lazy.Char8 as Char8
import Data.Coerce (coerce)
import Data.Proxy (Proxy (..))
import Data.String (IsString)
import Data.Text (Text)
import qualified Data.Text as Text
import Data.Time (UTCTime)
import Data.Typeable (Typeable, typeRep)
import Data.UUID (UUID)
import qualified Data.UUID.V4 as UUID.V4
import MessageDb.StreamName (StreamName)
import Numeric.Natural (Natural)


-- * JSON Helpers


parseJson :: Aeson.FromJSON value => Aeson.Value -> Either String value
parseJson :: Value -> Either String value
parseJson Value
column =
  let json :: Value
json = Value -> Value
coerce Value
column
   in (Value -> Parser value) -> Value -> Either String value
forall a b. (a -> Parser b) -> a -> Either String b
AesonTypes.parseEither Value -> Parser value
forall a. FromJSON a => Value -> Parser a
Aeson.parseJSON Value
json


showValue :: Aeson.Value -> String
showValue :: Value -> String
showValue =
  ByteString -> String
Char8.unpack (ByteString -> String) -> (Value -> ByteString) -> Value -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value -> ByteString
forall a. ToJSON a => a -> ByteString
Aeson.encode


-- * Message Id


-- | Unique id of a message. Most be unique across the entire event store.
newtype MessageId = MessageId
  { MessageId -> UUID
messageIdToUUID :: UUID
  }
  deriving
    ( Int -> MessageId -> ShowS
[MessageId] -> ShowS
MessageId -> String
(Int -> MessageId -> ShowS)
-> (MessageId -> String)
-> ([MessageId] -> ShowS)
-> Show MessageId
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [MessageId] -> ShowS
$cshowList :: [MessageId] -> ShowS
show :: MessageId -> String
$cshow :: MessageId -> String
showsPrec :: Int -> MessageId -> ShowS
$cshowsPrec :: Int -> MessageId -> ShowS
Show
    , MessageId -> MessageId -> Bool
(MessageId -> MessageId -> Bool)
-> (MessageId -> MessageId -> Bool) -> Eq MessageId
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MessageId -> MessageId -> Bool
$c/= :: MessageId -> MessageId -> Bool
== :: MessageId -> MessageId -> Bool
$c== :: MessageId -> MessageId -> Bool
Eq
    , Eq MessageId
Eq MessageId
-> (MessageId -> MessageId -> Ordering)
-> (MessageId -> MessageId -> Bool)
-> (MessageId -> MessageId -> Bool)
-> (MessageId -> MessageId -> Bool)
-> (MessageId -> MessageId -> Bool)
-> (MessageId -> MessageId -> MessageId)
-> (MessageId -> MessageId -> MessageId)
-> Ord MessageId
MessageId -> MessageId -> Bool
MessageId -> MessageId -> Ordering
MessageId -> MessageId -> MessageId
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 :: MessageId -> MessageId -> MessageId
$cmin :: MessageId -> MessageId -> MessageId
max :: MessageId -> MessageId -> MessageId
$cmax :: MessageId -> MessageId -> MessageId
>= :: MessageId -> MessageId -> Bool
$c>= :: MessageId -> MessageId -> Bool
> :: MessageId -> MessageId -> Bool
$c> :: MessageId -> MessageId -> Bool
<= :: MessageId -> MessageId -> Bool
$c<= :: MessageId -> MessageId -> Bool
< :: MessageId -> MessageId -> Bool
$c< :: MessageId -> MessageId -> Bool
compare :: MessageId -> MessageId -> Ordering
$ccompare :: MessageId -> MessageId -> Ordering
$cp1Ord :: Eq MessageId
Ord
    , Value -> Parser [MessageId]
Value -> Parser MessageId
(Value -> Parser MessageId)
-> (Value -> Parser [MessageId]) -> FromJSON MessageId
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [MessageId]
$cparseJSONList :: Value -> Parser [MessageId]
parseJSON :: Value -> Parser MessageId
$cparseJSON :: Value -> Parser MessageId
Aeson.FromJSON
    , [MessageId] -> Encoding
[MessageId] -> Value
MessageId -> Encoding
MessageId -> Value
(MessageId -> Value)
-> (MessageId -> Encoding)
-> ([MessageId] -> Value)
-> ([MessageId] -> Encoding)
-> ToJSON MessageId
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [MessageId] -> Encoding
$ctoEncodingList :: [MessageId] -> Encoding
toJSONList :: [MessageId] -> Value
$ctoJSONList :: [MessageId] -> Value
toEncoding :: MessageId -> Encoding
$ctoEncoding :: MessageId -> Encoding
toJSON :: MessageId -> Value
$ctoJSON :: MessageId -> Value
Aeson.ToJSON
    )
    via UUID


-- | Create a new unique message id.
newMessageId :: IO MessageId
newMessageId :: IO MessageId
newMessageId =
  (UUID -> MessageId) -> IO UUID -> IO MessageId
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap UUID -> MessageId
MessageId IO UUID
UUID.V4.nextRandom


-- * Message Type


-- | The type of a message. You can use this later to determine what kind of event or command a message is.
newtype MessageType = MessageType
  { MessageType -> Text
messageTypeToText :: Text
  }
  deriving
    ( MessageType -> MessageType -> Bool
(MessageType -> MessageType -> Bool)
-> (MessageType -> MessageType -> Bool) -> Eq MessageType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MessageType -> MessageType -> Bool
$c/= :: MessageType -> MessageType -> Bool
== :: MessageType -> MessageType -> Bool
$c== :: MessageType -> MessageType -> Bool
Eq
    , Eq MessageType
Eq MessageType
-> (MessageType -> MessageType -> Ordering)
-> (MessageType -> MessageType -> Bool)
-> (MessageType -> MessageType -> Bool)
-> (MessageType -> MessageType -> Bool)
-> (MessageType -> MessageType -> Bool)
-> (MessageType -> MessageType -> MessageType)
-> (MessageType -> MessageType -> MessageType)
-> Ord MessageType
MessageType -> MessageType -> Bool
MessageType -> MessageType -> Ordering
MessageType -> MessageType -> MessageType
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 :: MessageType -> MessageType -> MessageType
$cmin :: MessageType -> MessageType -> MessageType
max :: MessageType -> MessageType -> MessageType
$cmax :: MessageType -> MessageType -> MessageType
>= :: MessageType -> MessageType -> Bool
$c>= :: MessageType -> MessageType -> Bool
> :: MessageType -> MessageType -> Bool
$c> :: MessageType -> MessageType -> Bool
<= :: MessageType -> MessageType -> Bool
$c<= :: MessageType -> MessageType -> Bool
< :: MessageType -> MessageType -> Bool
$c< :: MessageType -> MessageType -> Bool
compare :: MessageType -> MessageType -> Ordering
$ccompare :: MessageType -> MessageType -> Ordering
$cp1Ord :: Eq MessageType
Ord
    , Int -> MessageType -> ShowS
[MessageType] -> ShowS
MessageType -> String
(Int -> MessageType -> ShowS)
-> (MessageType -> String)
-> ([MessageType] -> ShowS)
-> Show MessageType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [MessageType] -> ShowS
$cshowList :: [MessageType] -> ShowS
show :: MessageType -> String
$cshow :: MessageType -> String
showsPrec :: Int -> MessageType -> ShowS
$cshowsPrec :: Int -> MessageType -> ShowS
Show
    , String -> MessageType
(String -> MessageType) -> IsString MessageType
forall a. (String -> a) -> IsString a
fromString :: String -> MessageType
$cfromString :: String -> MessageType
IsString
    , [MessageType] -> Encoding
[MessageType] -> Value
MessageType -> Encoding
MessageType -> Value
(MessageType -> Value)
-> (MessageType -> Encoding)
-> ([MessageType] -> Value)
-> ([MessageType] -> Encoding)
-> ToJSON MessageType
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [MessageType] -> Encoding
$ctoEncodingList :: [MessageType] -> Encoding
toJSONList :: [MessageType] -> Value
$ctoJSONList :: [MessageType] -> Value
toEncoding :: MessageType -> Encoding
$ctoEncoding :: MessageType -> Encoding
toJSON :: MessageType -> Value
$ctoJSON :: MessageType -> Value
Aeson.ToJSON
    , Value -> Parser [MessageType]
Value -> Parser MessageType
(Value -> Parser MessageType)
-> (Value -> Parser [MessageType]) -> FromJSON MessageType
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [MessageType]
$cparseJSONList :: Value -> Parser [MessageType]
parseJSON :: Value -> Parser MessageType
$cparseJSON :: Value -> Parser MessageType
Aeson.FromJSON
    )
    via Text


-- | Converts a type's name to a 'MessageType'. For example 'typeOf @Bool' will be 'MessageType "Bool"'.
messageTypeOf :: forall payload. Typeable payload => MessageType
messageTypeOf :: MessageType
messageTypeOf =
  let eventName :: Text
eventName = String -> Text
Text.pack (String -> Text)
-> (Proxy payload -> String) -> Proxy payload -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TypeRep -> String
forall a. Show a => a -> String
show (TypeRep -> String)
-> (Proxy payload -> TypeRep) -> Proxy payload -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Proxy payload -> TypeRep
forall k (proxy :: k -> *) (a :: k).
Typeable a =>
proxy a -> TypeRep
typeRep (Proxy payload -> Text) -> Proxy payload -> Text
forall a b. (a -> b) -> a -> b
$ Proxy payload
forall k (t :: k). Proxy t
Proxy @payload
   in Text -> MessageType
MessageType Text
eventName


-- * Stream Position


-- | Position within a stream. This starts at 0 and has no gaps.
newtype StreamPosition = StreamPosition
  { StreamPosition -> Natural
streamPositionToNatural :: Natural
  }
  deriving
    ( Int -> StreamPosition -> ShowS
[StreamPosition] -> ShowS
StreamPosition -> String
(Int -> StreamPosition -> ShowS)
-> (StreamPosition -> String)
-> ([StreamPosition] -> ShowS)
-> Show StreamPosition
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [StreamPosition] -> ShowS
$cshowList :: [StreamPosition] -> ShowS
show :: StreamPosition -> String
$cshow :: StreamPosition -> String
showsPrec :: Int -> StreamPosition -> ShowS
$cshowsPrec :: Int -> StreamPosition -> ShowS
Show
    , StreamPosition -> StreamPosition -> Bool
(StreamPosition -> StreamPosition -> Bool)
-> (StreamPosition -> StreamPosition -> Bool) -> Eq StreamPosition
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: StreamPosition -> StreamPosition -> Bool
$c/= :: StreamPosition -> StreamPosition -> Bool
== :: StreamPosition -> StreamPosition -> Bool
$c== :: StreamPosition -> StreamPosition -> Bool
Eq
    , Eq StreamPosition
Eq StreamPosition
-> (StreamPosition -> StreamPosition -> Ordering)
-> (StreamPosition -> StreamPosition -> Bool)
-> (StreamPosition -> StreamPosition -> Bool)
-> (StreamPosition -> StreamPosition -> Bool)
-> (StreamPosition -> StreamPosition -> Bool)
-> (StreamPosition -> StreamPosition -> StreamPosition)
-> (StreamPosition -> StreamPosition -> StreamPosition)
-> Ord StreamPosition
StreamPosition -> StreamPosition -> Bool
StreamPosition -> StreamPosition -> Ordering
StreamPosition -> StreamPosition -> StreamPosition
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 :: StreamPosition -> StreamPosition -> StreamPosition
$cmin :: StreamPosition -> StreamPosition -> StreamPosition
max :: StreamPosition -> StreamPosition -> StreamPosition
$cmax :: StreamPosition -> StreamPosition -> StreamPosition
>= :: StreamPosition -> StreamPosition -> Bool
$c>= :: StreamPosition -> StreamPosition -> Bool
> :: StreamPosition -> StreamPosition -> Bool
$c> :: StreamPosition -> StreamPosition -> Bool
<= :: StreamPosition -> StreamPosition -> Bool
$c<= :: StreamPosition -> StreamPosition -> Bool
< :: StreamPosition -> StreamPosition -> Bool
$c< :: StreamPosition -> StreamPosition -> Bool
compare :: StreamPosition -> StreamPosition -> Ordering
$ccompare :: StreamPosition -> StreamPosition -> Ordering
$cp1Ord :: Eq StreamPosition
Ord
    , Integer -> StreamPosition
StreamPosition -> StreamPosition
StreamPosition -> StreamPosition -> StreamPosition
(StreamPosition -> StreamPosition -> StreamPosition)
-> (StreamPosition -> StreamPosition -> StreamPosition)
-> (StreamPosition -> StreamPosition -> StreamPosition)
-> (StreamPosition -> StreamPosition)
-> (StreamPosition -> StreamPosition)
-> (StreamPosition -> StreamPosition)
-> (Integer -> StreamPosition)
-> Num StreamPosition
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
fromInteger :: Integer -> StreamPosition
$cfromInteger :: Integer -> StreamPosition
signum :: StreamPosition -> StreamPosition
$csignum :: StreamPosition -> StreamPosition
abs :: StreamPosition -> StreamPosition
$cabs :: StreamPosition -> StreamPosition
negate :: StreamPosition -> StreamPosition
$cnegate :: StreamPosition -> StreamPosition
* :: StreamPosition -> StreamPosition -> StreamPosition
$c* :: StreamPosition -> StreamPosition -> StreamPosition
- :: StreamPosition -> StreamPosition -> StreamPosition
$c- :: StreamPosition -> StreamPosition -> StreamPosition
+ :: StreamPosition -> StreamPosition -> StreamPosition
$c+ :: StreamPosition -> StreamPosition -> StreamPosition
Num
    , Num StreamPosition
Ord StreamPosition
Num StreamPosition
-> Ord StreamPosition
-> (StreamPosition -> Rational)
-> Real StreamPosition
StreamPosition -> Rational
forall a. Num a -> Ord a -> (a -> Rational) -> Real a
toRational :: StreamPosition -> Rational
$ctoRational :: StreamPosition -> Rational
$cp2Real :: Ord StreamPosition
$cp1Real :: Num StreamPosition
Real
    , Int -> StreamPosition
StreamPosition -> Int
StreamPosition -> [StreamPosition]
StreamPosition -> StreamPosition
StreamPosition -> StreamPosition -> [StreamPosition]
StreamPosition
-> StreamPosition -> StreamPosition -> [StreamPosition]
(StreamPosition -> StreamPosition)
-> (StreamPosition -> StreamPosition)
-> (Int -> StreamPosition)
-> (StreamPosition -> Int)
-> (StreamPosition -> [StreamPosition])
-> (StreamPosition -> StreamPosition -> [StreamPosition])
-> (StreamPosition -> StreamPosition -> [StreamPosition])
-> (StreamPosition
    -> StreamPosition -> StreamPosition -> [StreamPosition])
-> Enum StreamPosition
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 :: StreamPosition
-> StreamPosition -> StreamPosition -> [StreamPosition]
$cenumFromThenTo :: StreamPosition
-> StreamPosition -> StreamPosition -> [StreamPosition]
enumFromTo :: StreamPosition -> StreamPosition -> [StreamPosition]
$cenumFromTo :: StreamPosition -> StreamPosition -> [StreamPosition]
enumFromThen :: StreamPosition -> StreamPosition -> [StreamPosition]
$cenumFromThen :: StreamPosition -> StreamPosition -> [StreamPosition]
enumFrom :: StreamPosition -> [StreamPosition]
$cenumFrom :: StreamPosition -> [StreamPosition]
fromEnum :: StreamPosition -> Int
$cfromEnum :: StreamPosition -> Int
toEnum :: Int -> StreamPosition
$ctoEnum :: Int -> StreamPosition
pred :: StreamPosition -> StreamPosition
$cpred :: StreamPosition -> StreamPosition
succ :: StreamPosition -> StreamPosition
$csucc :: StreamPosition -> StreamPosition
Enum
    , Enum StreamPosition
Real StreamPosition
Real StreamPosition
-> Enum StreamPosition
-> (StreamPosition -> StreamPosition -> StreamPosition)
-> (StreamPosition -> StreamPosition -> StreamPosition)
-> (StreamPosition -> StreamPosition -> StreamPosition)
-> (StreamPosition -> StreamPosition -> StreamPosition)
-> (StreamPosition
    -> StreamPosition -> (StreamPosition, StreamPosition))
-> (StreamPosition
    -> StreamPosition -> (StreamPosition, StreamPosition))
-> (StreamPosition -> Integer)
-> Integral StreamPosition
StreamPosition -> Integer
StreamPosition
-> StreamPosition -> (StreamPosition, StreamPosition)
StreamPosition -> StreamPosition -> StreamPosition
forall a.
Real a
-> Enum a
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> (a, a))
-> (a -> a -> (a, a))
-> (a -> Integer)
-> Integral a
toInteger :: StreamPosition -> Integer
$ctoInteger :: StreamPosition -> Integer
divMod :: StreamPosition
-> StreamPosition -> (StreamPosition, StreamPosition)
$cdivMod :: StreamPosition
-> StreamPosition -> (StreamPosition, StreamPosition)
quotRem :: StreamPosition
-> StreamPosition -> (StreamPosition, StreamPosition)
$cquotRem :: StreamPosition
-> StreamPosition -> (StreamPosition, StreamPosition)
mod :: StreamPosition -> StreamPosition -> StreamPosition
$cmod :: StreamPosition -> StreamPosition -> StreamPosition
div :: StreamPosition -> StreamPosition -> StreamPosition
$cdiv :: StreamPosition -> StreamPosition -> StreamPosition
rem :: StreamPosition -> StreamPosition -> StreamPosition
$crem :: StreamPosition -> StreamPosition -> StreamPosition
quot :: StreamPosition -> StreamPosition -> StreamPosition
$cquot :: StreamPosition -> StreamPosition -> StreamPosition
$cp2Integral :: Enum StreamPosition
$cp1Integral :: Real StreamPosition
Integral
    , [StreamPosition] -> Encoding
[StreamPosition] -> Value
StreamPosition -> Encoding
StreamPosition -> Value
(StreamPosition -> Value)
-> (StreamPosition -> Encoding)
-> ([StreamPosition] -> Value)
-> ([StreamPosition] -> Encoding)
-> ToJSON StreamPosition
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [StreamPosition] -> Encoding
$ctoEncodingList :: [StreamPosition] -> Encoding
toJSONList :: [StreamPosition] -> Value
$ctoJSONList :: [StreamPosition] -> Value
toEncoding :: StreamPosition -> Encoding
$ctoEncoding :: StreamPosition -> Encoding
toJSON :: StreamPosition -> Value
$ctoJSON :: StreamPosition -> Value
Aeson.ToJSON
    , Value -> Parser [StreamPosition]
Value -> Parser StreamPosition
(Value -> Parser StreamPosition)
-> (Value -> Parser [StreamPosition]) -> FromJSON StreamPosition
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [StreamPosition]
$cparseJSONList :: Value -> Parser [StreamPosition]
parseJSON :: Value -> Parser StreamPosition
$cparseJSON :: Value -> Parser StreamPosition
Aeson.FromJSON
    )
    via Natural


-- * Global Position


-- | Primary key. The ordinal position of the message in the entire message store. Global position may have gaps.
newtype GlobalPosition = GlobalPosition
  { GlobalPosition -> Integer
globalPositionToInteger :: Integer
  }
  deriving
    ( Int -> GlobalPosition -> ShowS
[GlobalPosition] -> ShowS
GlobalPosition -> String
(Int -> GlobalPosition -> ShowS)
-> (GlobalPosition -> String)
-> ([GlobalPosition] -> ShowS)
-> Show GlobalPosition
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GlobalPosition] -> ShowS
$cshowList :: [GlobalPosition] -> ShowS
show :: GlobalPosition -> String
$cshow :: GlobalPosition -> String
showsPrec :: Int -> GlobalPosition -> ShowS
$cshowsPrec :: Int -> GlobalPosition -> ShowS
Show
    , GlobalPosition -> GlobalPosition -> Bool
(GlobalPosition -> GlobalPosition -> Bool)
-> (GlobalPosition -> GlobalPosition -> Bool) -> Eq GlobalPosition
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GlobalPosition -> GlobalPosition -> Bool
$c/= :: GlobalPosition -> GlobalPosition -> Bool
== :: GlobalPosition -> GlobalPosition -> Bool
$c== :: GlobalPosition -> GlobalPosition -> Bool
Eq
    , Eq GlobalPosition
Eq GlobalPosition
-> (GlobalPosition -> GlobalPosition -> Ordering)
-> (GlobalPosition -> GlobalPosition -> Bool)
-> (GlobalPosition -> GlobalPosition -> Bool)
-> (GlobalPosition -> GlobalPosition -> Bool)
-> (GlobalPosition -> GlobalPosition -> Bool)
-> (GlobalPosition -> GlobalPosition -> GlobalPosition)
-> (GlobalPosition -> GlobalPosition -> GlobalPosition)
-> Ord GlobalPosition
GlobalPosition -> GlobalPosition -> Bool
GlobalPosition -> GlobalPosition -> Ordering
GlobalPosition -> GlobalPosition -> GlobalPosition
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 :: GlobalPosition -> GlobalPosition -> GlobalPosition
$cmin :: GlobalPosition -> GlobalPosition -> GlobalPosition
max :: GlobalPosition -> GlobalPosition -> GlobalPosition
$cmax :: GlobalPosition -> GlobalPosition -> GlobalPosition
>= :: GlobalPosition -> GlobalPosition -> Bool
$c>= :: GlobalPosition -> GlobalPosition -> Bool
> :: GlobalPosition -> GlobalPosition -> Bool
$c> :: GlobalPosition -> GlobalPosition -> Bool
<= :: GlobalPosition -> GlobalPosition -> Bool
$c<= :: GlobalPosition -> GlobalPosition -> Bool
< :: GlobalPosition -> GlobalPosition -> Bool
$c< :: GlobalPosition -> GlobalPosition -> Bool
compare :: GlobalPosition -> GlobalPosition -> Ordering
$ccompare :: GlobalPosition -> GlobalPosition -> Ordering
$cp1Ord :: Eq GlobalPosition
Ord
    , Integer -> GlobalPosition
GlobalPosition -> GlobalPosition
GlobalPosition -> GlobalPosition -> GlobalPosition
(GlobalPosition -> GlobalPosition -> GlobalPosition)
-> (GlobalPosition -> GlobalPosition -> GlobalPosition)
-> (GlobalPosition -> GlobalPosition -> GlobalPosition)
-> (GlobalPosition -> GlobalPosition)
-> (GlobalPosition -> GlobalPosition)
-> (GlobalPosition -> GlobalPosition)
-> (Integer -> GlobalPosition)
-> Num GlobalPosition
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
fromInteger :: Integer -> GlobalPosition
$cfromInteger :: Integer -> GlobalPosition
signum :: GlobalPosition -> GlobalPosition
$csignum :: GlobalPosition -> GlobalPosition
abs :: GlobalPosition -> GlobalPosition
$cabs :: GlobalPosition -> GlobalPosition
negate :: GlobalPosition -> GlobalPosition
$cnegate :: GlobalPosition -> GlobalPosition
* :: GlobalPosition -> GlobalPosition -> GlobalPosition
$c* :: GlobalPosition -> GlobalPosition -> GlobalPosition
- :: GlobalPosition -> GlobalPosition -> GlobalPosition
$c- :: GlobalPosition -> GlobalPosition -> GlobalPosition
+ :: GlobalPosition -> GlobalPosition -> GlobalPosition
$c+ :: GlobalPosition -> GlobalPosition -> GlobalPosition
Num
    , Num GlobalPosition
Ord GlobalPosition
Num GlobalPosition
-> Ord GlobalPosition
-> (GlobalPosition -> Rational)
-> Real GlobalPosition
GlobalPosition -> Rational
forall a. Num a -> Ord a -> (a -> Rational) -> Real a
toRational :: GlobalPosition -> Rational
$ctoRational :: GlobalPosition -> Rational
$cp2Real :: Ord GlobalPosition
$cp1Real :: Num GlobalPosition
Real
    , Int -> GlobalPosition
GlobalPosition -> Int
GlobalPosition -> [GlobalPosition]
GlobalPosition -> GlobalPosition
GlobalPosition -> GlobalPosition -> [GlobalPosition]
GlobalPosition
-> GlobalPosition -> GlobalPosition -> [GlobalPosition]
(GlobalPosition -> GlobalPosition)
-> (GlobalPosition -> GlobalPosition)
-> (Int -> GlobalPosition)
-> (GlobalPosition -> Int)
-> (GlobalPosition -> [GlobalPosition])
-> (GlobalPosition -> GlobalPosition -> [GlobalPosition])
-> (GlobalPosition -> GlobalPosition -> [GlobalPosition])
-> (GlobalPosition
    -> GlobalPosition -> GlobalPosition -> [GlobalPosition])
-> Enum GlobalPosition
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 :: GlobalPosition
-> GlobalPosition -> GlobalPosition -> [GlobalPosition]
$cenumFromThenTo :: GlobalPosition
-> GlobalPosition -> GlobalPosition -> [GlobalPosition]
enumFromTo :: GlobalPosition -> GlobalPosition -> [GlobalPosition]
$cenumFromTo :: GlobalPosition -> GlobalPosition -> [GlobalPosition]
enumFromThen :: GlobalPosition -> GlobalPosition -> [GlobalPosition]
$cenumFromThen :: GlobalPosition -> GlobalPosition -> [GlobalPosition]
enumFrom :: GlobalPosition -> [GlobalPosition]
$cenumFrom :: GlobalPosition -> [GlobalPosition]
fromEnum :: GlobalPosition -> Int
$cfromEnum :: GlobalPosition -> Int
toEnum :: Int -> GlobalPosition
$ctoEnum :: Int -> GlobalPosition
pred :: GlobalPosition -> GlobalPosition
$cpred :: GlobalPosition -> GlobalPosition
succ :: GlobalPosition -> GlobalPosition
$csucc :: GlobalPosition -> GlobalPosition
Enum
    , Enum GlobalPosition
Real GlobalPosition
Real GlobalPosition
-> Enum GlobalPosition
-> (GlobalPosition -> GlobalPosition -> GlobalPosition)
-> (GlobalPosition -> GlobalPosition -> GlobalPosition)
-> (GlobalPosition -> GlobalPosition -> GlobalPosition)
-> (GlobalPosition -> GlobalPosition -> GlobalPosition)
-> (GlobalPosition
    -> GlobalPosition -> (GlobalPosition, GlobalPosition))
-> (GlobalPosition
    -> GlobalPosition -> (GlobalPosition, GlobalPosition))
-> (GlobalPosition -> Integer)
-> Integral GlobalPosition
GlobalPosition -> Integer
GlobalPosition
-> GlobalPosition -> (GlobalPosition, GlobalPosition)
GlobalPosition -> GlobalPosition -> GlobalPosition
forall a.
Real a
-> Enum a
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> (a, a))
-> (a -> a -> (a, a))
-> (a -> Integer)
-> Integral a
toInteger :: GlobalPosition -> Integer
$ctoInteger :: GlobalPosition -> Integer
divMod :: GlobalPosition
-> GlobalPosition -> (GlobalPosition, GlobalPosition)
$cdivMod :: GlobalPosition
-> GlobalPosition -> (GlobalPosition, GlobalPosition)
quotRem :: GlobalPosition
-> GlobalPosition -> (GlobalPosition, GlobalPosition)
$cquotRem :: GlobalPosition
-> GlobalPosition -> (GlobalPosition, GlobalPosition)
mod :: GlobalPosition -> GlobalPosition -> GlobalPosition
$cmod :: GlobalPosition -> GlobalPosition -> GlobalPosition
div :: GlobalPosition -> GlobalPosition -> GlobalPosition
$cdiv :: GlobalPosition -> GlobalPosition -> GlobalPosition
rem :: GlobalPosition -> GlobalPosition -> GlobalPosition
$crem :: GlobalPosition -> GlobalPosition -> GlobalPosition
quot :: GlobalPosition -> GlobalPosition -> GlobalPosition
$cquot :: GlobalPosition -> GlobalPosition -> GlobalPosition
$cp2Integral :: Enum GlobalPosition
$cp1Integral :: Real GlobalPosition
Integral
    , [GlobalPosition] -> Encoding
[GlobalPosition] -> Value
GlobalPosition -> Encoding
GlobalPosition -> Value
(GlobalPosition -> Value)
-> (GlobalPosition -> Encoding)
-> ([GlobalPosition] -> Value)
-> ([GlobalPosition] -> Encoding)
-> ToJSON GlobalPosition
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [GlobalPosition] -> Encoding
$ctoEncodingList :: [GlobalPosition] -> Encoding
toJSONList :: [GlobalPosition] -> Value
$ctoJSONList :: [GlobalPosition] -> Value
toEncoding :: GlobalPosition -> Encoding
$ctoEncoding :: GlobalPosition -> Encoding
toJSON :: GlobalPosition -> Value
$ctoJSON :: GlobalPosition -> Value
Aeson.ToJSON
    , Value -> Parser [GlobalPosition]
Value -> Parser GlobalPosition
(Value -> Parser GlobalPosition)
-> (Value -> Parser [GlobalPosition]) -> FromJSON GlobalPosition
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [GlobalPosition]
$cparseJSONList :: Value -> Parser [GlobalPosition]
parseJSON :: Value -> Parser GlobalPosition
$cparseJSON :: Value -> Parser GlobalPosition
Aeson.FromJSON
    )
    via Integer


-- * Created at Timestamp


-- | Timestamp when the message was written.
newtype CreatedAt = CreatedAt
  { CreatedAt -> UTCTime
createdAtToUTCTime :: UTCTime
  }
  deriving
    ( Int -> CreatedAt -> ShowS
[CreatedAt] -> ShowS
CreatedAt -> String
(Int -> CreatedAt -> ShowS)
-> (CreatedAt -> String)
-> ([CreatedAt] -> ShowS)
-> Show CreatedAt
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreatedAt] -> ShowS
$cshowList :: [CreatedAt] -> ShowS
show :: CreatedAt -> String
$cshow :: CreatedAt -> String
showsPrec :: Int -> CreatedAt -> ShowS
$cshowsPrec :: Int -> CreatedAt -> ShowS
Show
    , CreatedAt -> CreatedAt -> Bool
(CreatedAt -> CreatedAt -> Bool)
-> (CreatedAt -> CreatedAt -> Bool) -> Eq CreatedAt
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreatedAt -> CreatedAt -> Bool
$c/= :: CreatedAt -> CreatedAt -> Bool
== :: CreatedAt -> CreatedAt -> Bool
$c== :: CreatedAt -> CreatedAt -> Bool
Eq
    , Eq CreatedAt
Eq CreatedAt
-> (CreatedAt -> CreatedAt -> Ordering)
-> (CreatedAt -> CreatedAt -> Bool)
-> (CreatedAt -> CreatedAt -> Bool)
-> (CreatedAt -> CreatedAt -> Bool)
-> (CreatedAt -> CreatedAt -> Bool)
-> (CreatedAt -> CreatedAt -> CreatedAt)
-> (CreatedAt -> CreatedAt -> CreatedAt)
-> Ord CreatedAt
CreatedAt -> CreatedAt -> Bool
CreatedAt -> CreatedAt -> Ordering
CreatedAt -> CreatedAt -> CreatedAt
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 :: CreatedAt -> CreatedAt -> CreatedAt
$cmin :: CreatedAt -> CreatedAt -> CreatedAt
max :: CreatedAt -> CreatedAt -> CreatedAt
$cmax :: CreatedAt -> CreatedAt -> CreatedAt
>= :: CreatedAt -> CreatedAt -> Bool
$c>= :: CreatedAt -> CreatedAt -> Bool
> :: CreatedAt -> CreatedAt -> Bool
$c> :: CreatedAt -> CreatedAt -> Bool
<= :: CreatedAt -> CreatedAt -> Bool
$c<= :: CreatedAt -> CreatedAt -> Bool
< :: CreatedAt -> CreatedAt -> Bool
$c< :: CreatedAt -> CreatedAt -> Bool
compare :: CreatedAt -> CreatedAt -> Ordering
$ccompare :: CreatedAt -> CreatedAt -> Ordering
$cp1Ord :: Eq CreatedAt
Ord
    , [CreatedAt] -> Encoding
[CreatedAt] -> Value
CreatedAt -> Encoding
CreatedAt -> Value
(CreatedAt -> Value)
-> (CreatedAt -> Encoding)
-> ([CreatedAt] -> Value)
-> ([CreatedAt] -> Encoding)
-> ToJSON CreatedAt
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [CreatedAt] -> Encoding
$ctoEncodingList :: [CreatedAt] -> Encoding
toJSONList :: [CreatedAt] -> Value
$ctoJSONList :: [CreatedAt] -> Value
toEncoding :: CreatedAt -> Encoding
$ctoEncoding :: CreatedAt -> Encoding
toJSON :: CreatedAt -> Value
$ctoJSON :: CreatedAt -> Value
Aeson.ToJSON
    , Value -> Parser [CreatedAt]
Value -> Parser CreatedAt
(Value -> Parser CreatedAt)
-> (Value -> Parser [CreatedAt]) -> FromJSON CreatedAt
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [CreatedAt]
$cparseJSONList :: Value -> Parser [CreatedAt]
parseJSON :: Value -> Parser CreatedAt
$cparseJSON :: Value -> Parser CreatedAt
Aeson.FromJSON
    )
    via UTCTime


-- * Payload


newtype Payload = Payload
  { Payload -> Value
payloadToValue :: Aeson.Value
  }
  deriving
    ( Payload -> Payload -> Bool
(Payload -> Payload -> Bool)
-> (Payload -> Payload -> Bool) -> Eq Payload
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Payload -> Payload -> Bool
$c/= :: Payload -> Payload -> Bool
== :: Payload -> Payload -> Bool
$c== :: Payload -> Payload -> Bool
Eq
    , [Payload] -> Encoding
[Payload] -> Value
Payload -> Encoding
Payload -> Value
(Payload -> Value)
-> (Payload -> Encoding)
-> ([Payload] -> Value)
-> ([Payload] -> Encoding)
-> ToJSON Payload
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [Payload] -> Encoding
$ctoEncodingList :: [Payload] -> Encoding
toJSONList :: [Payload] -> Value
$ctoJSONList :: [Payload] -> Value
toEncoding :: Payload -> Encoding
$ctoEncoding :: Payload -> Encoding
toJSON :: Payload -> Value
$ctoJSON :: Payload -> Value
Aeson.ToJSON
    , Value -> Parser [Payload]
Value -> Parser Payload
(Value -> Parser Payload)
-> (Value -> Parser [Payload]) -> FromJSON Payload
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [Payload]
$cparseJSONList :: Value -> Parser [Payload]
parseJSON :: Value -> Parser Payload
$cparseJSON :: Value -> Parser Payload
Aeson.FromJSON
    )
    via Aeson.Value


instance Show Payload where
  show :: Payload -> String
show = Value -> String
showValue (Value -> String) -> (Payload -> Value) -> Payload -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Payload -> Value
payloadToValue


nullPayload :: Payload
nullPayload :: Payload
nullPayload =
  Value -> Payload
Payload Value
Aeson.Null


parsePayload :: Aeson.FromJSON value => Payload -> Either String value
parsePayload :: Payload -> Either String value
parsePayload =
  Value -> Either String value
forall value. FromJSON value => Value -> Either String value
parseJson (Value -> Either String value)
-> (Payload -> Value) -> Payload -> Either String value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Payload -> Value
payloadToValue


-- * Metadata


newtype Metadata = Metadata
  { Metadata -> Value
metadataToValue :: Aeson.Value
  }
  deriving
    ( Metadata -> Metadata -> Bool
(Metadata -> Metadata -> Bool)
-> (Metadata -> Metadata -> Bool) -> Eq Metadata
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Metadata -> Metadata -> Bool
$c/= :: Metadata -> Metadata -> Bool
== :: Metadata -> Metadata -> Bool
$c== :: Metadata -> Metadata -> Bool
Eq
    , [Metadata] -> Encoding
[Metadata] -> Value
Metadata -> Encoding
Metadata -> Value
(Metadata -> Value)
-> (Metadata -> Encoding)
-> ([Metadata] -> Value)
-> ([Metadata] -> Encoding)
-> ToJSON Metadata
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [Metadata] -> Encoding
$ctoEncodingList :: [Metadata] -> Encoding
toJSONList :: [Metadata] -> Value
$ctoJSONList :: [Metadata] -> Value
toEncoding :: Metadata -> Encoding
$ctoEncoding :: Metadata -> Encoding
toJSON :: Metadata -> Value
$ctoJSON :: Metadata -> Value
Aeson.ToJSON
    , Value -> Parser [Metadata]
Value -> Parser Metadata
(Value -> Parser Metadata)
-> (Value -> Parser [Metadata]) -> FromJSON Metadata
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [Metadata]
$cparseJSONList :: Value -> Parser [Metadata]
parseJSON :: Value -> Parser Metadata
$cparseJSON :: Value -> Parser Metadata
Aeson.FromJSON
    )
    via Aeson.Value


instance Show Metadata where
  show :: Metadata -> String
show = Value -> String
showValue (Value -> String) -> (Metadata -> Value) -> Metadata -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Metadata -> Value
metadataToValue


nullMetadata :: Metadata
nullMetadata :: Metadata
nullMetadata =
  Value -> Metadata
Metadata Value
Aeson.Null


parseMetadata :: Aeson.FromJSON value => Metadata -> Either String value
parseMetadata :: Metadata -> Either String value
parseMetadata =
  Value -> Either String value
forall value. FromJSON value => Value -> Either String value
parseJson (Value -> Either String value)
-> (Metadata -> Value) -> Metadata -> Either String value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Metadata -> Value
metadataToValue


-- * Message


data Message = Message
  { Message -> MessageId
messageId :: MessageId
  , Message -> StreamName
messageStream :: StreamName
  , Message -> MessageType
messageType :: MessageType
  , Message -> StreamPosition
messageStreamPosition :: StreamPosition
  , Message -> GlobalPosition
messageGlobalPosition :: GlobalPosition
  , Message -> CreatedAt
messageCreatedAt :: CreatedAt
  , Message -> Payload
messagePayload :: Payload
  , Message -> Metadata
messageMetadata :: Metadata
  }
  deriving (Int -> Message -> ShowS
[Message] -> ShowS
Message -> String
(Int -> Message -> ShowS)
-> (Message -> String) -> ([Message] -> ShowS) -> Show Message
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Message] -> ShowS
$cshowList :: [Message] -> ShowS
show :: Message -> String
$cshow :: Message -> String
showsPrec :: Int -> Message -> ShowS
$cshowsPrec :: Int -> Message -> ShowS
Show, Message -> Message -> Bool
(Message -> Message -> Bool)
-> (Message -> Message -> Bool) -> Eq Message
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Message -> Message -> Bool
$c/= :: Message -> Message -> Bool
== :: Message -> Message -> Bool
$c== :: Message -> Message -> Bool
Eq)


toKeyValues :: Aeson.KeyValue keyValue => Message -> [keyValue]
toKeyValues :: Message -> [keyValue]
toKeyValues Message{StreamName
Metadata
Payload
CreatedAt
GlobalPosition
StreamPosition
MessageType
MessageId
messageMetadata :: Metadata
messagePayload :: Payload
messageCreatedAt :: CreatedAt
messageGlobalPosition :: GlobalPosition
messageStreamPosition :: StreamPosition
messageType :: MessageType
messageStream :: StreamName
messageId :: MessageId
messageMetadata :: Message -> Metadata
messagePayload :: Message -> Payload
messageCreatedAt :: Message -> CreatedAt
messageGlobalPosition :: Message -> GlobalPosition
messageStreamPosition :: Message -> StreamPosition
messageType :: Message -> MessageType
messageStream :: Message -> StreamName
messageId :: Message -> MessageId
..} =
  [ Key
"id" Key -> MessageId -> keyValue
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= MessageId
messageId
  , Key
"streamName" Key -> StreamName -> keyValue
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= StreamName
messageStream
  , Key
"type" Key -> MessageType -> keyValue
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= MessageType
messageType
  , Key
"streamPosition" Key -> StreamPosition -> keyValue
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= StreamPosition
messageStreamPosition
  , Key
"globalPosition" Key -> GlobalPosition -> keyValue
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= GlobalPosition
messageGlobalPosition
  , Key
"createdAt" Key -> CreatedAt -> keyValue
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= CreatedAt
messageCreatedAt
  , Key
"payload" Key -> Payload -> keyValue
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Payload
messagePayload
  , Key
"metadata" Key -> Metadata -> keyValue
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Metadata
messageMetadata
  ]


instance Aeson.ToJSON Message where
  toJSON :: Message -> Value
toJSON = [Pair] -> Value
Aeson.object ([Pair] -> Value) -> (Message -> [Pair]) -> Message -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Message -> [Pair]
forall keyValue. KeyValue keyValue => Message -> [keyValue]
toKeyValues
  toEncoding :: Message -> Encoding
toEncoding = Series -> Encoding
Aeson.pairs (Series -> Encoding) -> (Message -> Series) -> Message -> Encoding
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Series] -> Series
forall a. Monoid a => [a] -> a
mconcat ([Series] -> Series) -> (Message -> [Series]) -> Message -> Series
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Message -> [Series]
forall keyValue. KeyValue keyValue => Message -> [keyValue]
toKeyValues


instance Aeson.FromJSON Message where
  parseJSON :: Value -> Parser Message
parseJSON = String -> (Object -> Parser Message) -> Value -> Parser Message
forall a. String -> (Object -> Parser a) -> Value -> Parser a
Aeson.withObject String
"Message" ((Object -> Parser Message) -> Value -> Parser Message)
-> (Object -> Parser Message) -> Value -> Parser Message
forall a b. (a -> b) -> a -> b
$ \Object
object -> do
    MessageId
messageId <- Object
object Object -> Key -> Parser MessageId
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"id"
    StreamName
messageStream <- Object
object Object -> Key -> Parser StreamName
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"streamName"
    MessageType
messageType <- Object
object Object -> Key -> Parser MessageType
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"type"
    StreamPosition
messageStreamPosition <- Object
object Object -> Key -> Parser StreamPosition
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"streamPosition"
    GlobalPosition
messageGlobalPosition <- Object
object Object -> Key -> Parser GlobalPosition
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"globalPosition"
    CreatedAt
messageCreatedAt <- Object
object Object -> Key -> Parser CreatedAt
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"createdAt"
    Payload
messagePayload <- Object
object Object -> Key -> Parser (Maybe Payload)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"payload" Parser (Maybe Payload) -> Payload -> Parser Payload
forall a. Parser (Maybe a) -> a -> Parser a
.!= Payload
nullPayload
    Metadata
messageMetadata <- Object
object Object -> Key -> Parser (Maybe Metadata)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"metadata" Parser (Maybe Metadata) -> Metadata -> Parser Metadata
forall a. Parser (Maybe a) -> a -> Parser a
.!= Metadata
nullMetadata
    Message -> Parser Message
forall (f :: * -> *) a. Applicative f => a -> f a
pure
      Message :: MessageId
-> StreamName
-> MessageType
-> StreamPosition
-> GlobalPosition
-> CreatedAt
-> Payload
-> Metadata
-> Message
Message
        { messageId :: MessageId
messageId = MessageId
messageId
        , messageStream :: StreamName
messageStream = StreamName
messageStream
        , messageType :: MessageType
messageType = MessageType
messageType
        , messageStreamPosition :: StreamPosition
messageStreamPosition = StreamPosition
messageStreamPosition
        , messageGlobalPosition :: GlobalPosition
messageGlobalPosition = GlobalPosition
messageGlobalPosition
        , messageCreatedAt :: CreatedAt
messageCreatedAt = CreatedAt
messageCreatedAt
        , messagePayload :: Payload
messagePayload = Payload
messagePayload
        , messageMetadata :: Metadata
messageMetadata = Metadata
messageMetadata
        }


-- * Parsed Message


data ParseMessageFailure = ParseMessageFailure
  { ParseMessageFailure -> Maybe String
failedPayloadReason :: Maybe String
  , ParseMessageFailure -> Maybe String
failedMetadataReason :: Maybe String
  }
  deriving (Int -> ParseMessageFailure -> ShowS
[ParseMessageFailure] -> ShowS
ParseMessageFailure -> String
(Int -> ParseMessageFailure -> ShowS)
-> (ParseMessageFailure -> String)
-> ([ParseMessageFailure] -> ShowS)
-> Show ParseMessageFailure
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ParseMessageFailure] -> ShowS
$cshowList :: [ParseMessageFailure] -> ShowS
show :: ParseMessageFailure -> String
$cshow :: ParseMessageFailure -> String
showsPrec :: Int -> ParseMessageFailure -> ShowS
$cshowsPrec :: Int -> ParseMessageFailure -> ShowS
Show, ParseMessageFailure -> ParseMessageFailure -> Bool
(ParseMessageFailure -> ParseMessageFailure -> Bool)
-> (ParseMessageFailure -> ParseMessageFailure -> Bool)
-> Eq ParseMessageFailure
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ParseMessageFailure -> ParseMessageFailure -> Bool
$c/= :: ParseMessageFailure -> ParseMessageFailure -> Bool
== :: ParseMessageFailure -> ParseMessageFailure -> Bool
$c== :: ParseMessageFailure -> ParseMessageFailure -> Bool
Eq)


parseMessageFailureToKeyValues :: Aeson.KeyValue kv => ParseMessageFailure -> [kv]
parseMessageFailureToKeyValues :: ParseMessageFailure -> [kv]
parseMessageFailureToKeyValues ParseMessageFailure{Maybe String
failedMetadataReason :: Maybe String
failedPayloadReason :: Maybe String
failedMetadataReason :: ParseMessageFailure -> Maybe String
failedPayloadReason :: ParseMessageFailure -> Maybe String
..} =
  [ Key
"failedPayloadReason" Key -> Maybe String -> kv
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe String
failedPayloadReason
  , Key
"failedMetadataReason" Key -> Maybe String -> kv
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe String
failedMetadataReason
  ]


instance Aeson.ToJSON ParseMessageFailure where
  toJSON :: ParseMessageFailure -> Value
toJSON = [Pair] -> Value
Aeson.object ([Pair] -> Value)
-> (ParseMessageFailure -> [Pair]) -> ParseMessageFailure -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ParseMessageFailure -> [Pair]
forall kv. KeyValue kv => ParseMessageFailure -> [kv]
parseMessageFailureToKeyValues
  toEncoding :: ParseMessageFailure -> Encoding
toEncoding = Series -> Encoding
Aeson.pairs (Series -> Encoding)
-> (ParseMessageFailure -> Series)
-> ParseMessageFailure
-> Encoding
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Series] -> Series
forall a. Monoid a => [a] -> a
mconcat ([Series] -> Series)
-> (ParseMessageFailure -> [Series])
-> ParseMessageFailure
-> Series
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ParseMessageFailure -> [Series]
forall kv. KeyValue kv => ParseMessageFailure -> [kv]
parseMessageFailureToKeyValues


instance Aeson.FromJSON ParseMessageFailure where
  parseJSON :: Value -> Parser ParseMessageFailure
parseJSON = String
-> (Object -> Parser ParseMessageFailure)
-> Value
-> Parser ParseMessageFailure
forall a. String -> (Object -> Parser a) -> Value -> Parser a
Aeson.withObject String
"ParseMessageFailure" ((Object -> Parser ParseMessageFailure)
 -> Value -> Parser ParseMessageFailure)
-> (Object -> Parser ParseMessageFailure)
-> Value
-> Parser ParseMessageFailure
forall a b. (a -> b) -> a -> b
$ \Object
object ->
    Maybe String -> Maybe String -> ParseMessageFailure
ParseMessageFailure
      (Maybe String -> Maybe String -> ParseMessageFailure)
-> Parser (Maybe String)
-> Parser (Maybe String -> ParseMessageFailure)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
object Object -> Key -> Parser (Maybe String)
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"failedPayloadReason"
      Parser (Maybe String -> ParseMessageFailure)
-> Parser (Maybe String) -> Parser ParseMessageFailure
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
object Object -> Key -> Parser (Maybe String)
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"failedMetadataReason"


instance Exception ParseMessageFailure


data ParsedMessage payload metadata = ParsedMessage
  { ParsedMessage payload metadata -> payload
parsedPayload :: payload
  , ParsedMessage payload metadata -> metadata
parsedMetadata :: metadata
  }
  deriving (Int -> ParsedMessage payload metadata -> ShowS
[ParsedMessage payload metadata] -> ShowS
ParsedMessage payload metadata -> String
(Int -> ParsedMessage payload metadata -> ShowS)
-> (ParsedMessage payload metadata -> String)
-> ([ParsedMessage payload metadata] -> ShowS)
-> Show (ParsedMessage payload metadata)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall payload metadata.
(Show payload, Show metadata) =>
Int -> ParsedMessage payload metadata -> ShowS
forall payload metadata.
(Show payload, Show metadata) =>
[ParsedMessage payload metadata] -> ShowS
forall payload metadata.
(Show payload, Show metadata) =>
ParsedMessage payload metadata -> String
showList :: [ParsedMessage payload metadata] -> ShowS
$cshowList :: forall payload metadata.
(Show payload, Show metadata) =>
[ParsedMessage payload metadata] -> ShowS
show :: ParsedMessage payload metadata -> String
$cshow :: forall payload metadata.
(Show payload, Show metadata) =>
ParsedMessage payload metadata -> String
showsPrec :: Int -> ParsedMessage payload metadata -> ShowS
$cshowsPrec :: forall payload metadata.
(Show payload, Show metadata) =>
Int -> ParsedMessage payload metadata -> ShowS
Show, ParsedMessage payload metadata
-> ParsedMessage payload metadata -> Bool
(ParsedMessage payload metadata
 -> ParsedMessage payload metadata -> Bool)
-> (ParsedMessage payload metadata
    -> ParsedMessage payload metadata -> Bool)
-> Eq (ParsedMessage payload metadata)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall payload metadata.
(Eq payload, Eq metadata) =>
ParsedMessage payload metadata
-> ParsedMessage payload metadata -> Bool
/= :: ParsedMessage payload metadata
-> ParsedMessage payload metadata -> Bool
$c/= :: forall payload metadata.
(Eq payload, Eq metadata) =>
ParsedMessage payload metadata
-> ParsedMessage payload metadata -> Bool
== :: ParsedMessage payload metadata
-> ParsedMessage payload metadata -> Bool
$c== :: forall payload metadata.
(Eq payload, Eq metadata) =>
ParsedMessage payload metadata
-> ParsedMessage payload metadata -> Bool
Eq)


parseMessage :: (Aeson.FromJSON payload, Aeson.FromJSON metadata) => Message -> Either ParseMessageFailure (ParsedMessage payload metadata)
parseMessage :: Message
-> Either ParseMessageFailure (ParsedMessage payload metadata)
parseMessage Message{Payload
messagePayload :: Payload
messagePayload :: Message -> Payload
messagePayload, Metadata
messageMetadata :: Metadata
messageMetadata :: Message -> Metadata
messageMetadata} =
  case (Payload -> Either String payload
forall value. FromJSON value => Payload -> Either String value
parsePayload Payload
messagePayload, Metadata -> Either String metadata
forall value. FromJSON value => Metadata -> Either String value
parseMetadata Metadata
messageMetadata) of
    (Right payload
parsedPayload, Right metadata
parsedMetadata) ->
      ParsedMessage payload metadata
-> Either ParseMessageFailure (ParsedMessage payload metadata)
forall a b. b -> Either a b
Right (ParsedMessage payload metadata
 -> Either ParseMessageFailure (ParsedMessage payload metadata))
-> ParsedMessage payload metadata
-> Either ParseMessageFailure (ParsedMessage payload metadata)
forall a b. (a -> b) -> a -> b
$ payload -> metadata -> ParsedMessage payload metadata
forall payload metadata.
payload -> metadata -> ParsedMessage payload metadata
ParsedMessage payload
parsedPayload metadata
parsedMetadata
    (Either String payload
payloadResult, Either String metadata
metadataResult) ->
      let toMaybe :: Either a b -> Maybe a
toMaybe = (a -> Maybe a) -> (b -> Maybe a) -> Either a b -> Maybe a
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either a -> Maybe a
forall a. a -> Maybe a
Just (Maybe a -> b -> Maybe a
forall a b. a -> b -> a
const Maybe a
forall a. Maybe a
Nothing)
       in ParseMessageFailure
-> Either ParseMessageFailure (ParsedMessage payload metadata)
forall a b. a -> Either a b
Left (ParseMessageFailure
 -> Either ParseMessageFailure (ParsedMessage payload metadata))
-> ParseMessageFailure
-> Either ParseMessageFailure (ParsedMessage payload metadata)
forall a b. (a -> b) -> a -> b
$
            ParseMessageFailure :: Maybe String -> Maybe String -> ParseMessageFailure
ParseMessageFailure
              { failedPayloadReason :: Maybe String
failedPayloadReason = Either String payload -> Maybe String
forall a b. Either a b -> Maybe a
toMaybe Either String payload
payloadResult
              , failedMetadataReason :: Maybe String
failedMetadataReason = Either String metadata -> Maybe String
forall a b. Either a b -> Maybe a
toMaybe Either String metadata
metadataResult
              }