{-# LANGUAGE GADTs #-}

-- | A module for creating great logs in code using Kafka.
module Log.Kafka
  ( emptyDetails,
    Details,
    topic,
    partitionId,
    key,
    contents,
    createTime,
    logAppendTime,
    processAttempt,
    assignedPartitions,
    pausedPartitions,
    timeSinceLastRebalance,
    requestId,
    mkContents,
    Contents,
  )
where

import qualified Data.Aeson as Aeson
import qualified Data.Time.Clock as Clock
import qualified Platform

-- | A type describing a kafka message being processed by a consumer.
--
-- > emptyDetails
-- >   { topic = Just "kafka-topic"
-- >   , partitionId = Just 1
-- >   , contents = Just (mkContents "This message is a JSON string!")
-- >   }
data Details = Details
  { -- | The topic name of the message.
    Details -> Maybe Text
topic :: Maybe Text,
    -- | The partition id of the message.
    Details -> Maybe Int
partitionId :: Maybe Int,
    -- | The key of the message (if it has one). If a key is provided by a
    -- message producer it is used to determine the partition id, in such a way
    -- that messages with the same key are guaranteed to end up in the same
    -- partition.
    Details -> Maybe Text
key :: Maybe Text,
    -- | The contents of the message.
    Details -> Maybe Contents
contents :: Maybe Contents,
    -- | The time at which this message was created by a producer.
    -- Whether this property is available for a message depends on the
    -- `log.message.timestamp.type` configuration option.
    -- More context: https://github.com/edenhill/librdkafka/blob/8bacbc0b4c357193288c81277bfcc815633126ea/INTRODUCTION.md#latency-measurement
    Details -> Maybe UTCTime
createTime :: Maybe Clock.UTCTime,
    -- | The time at which this message was added to a log by a broker.
    -- Whether this property is available for a message depends on the
    -- `log.message.timestamp.type` configuration option.
    -- More context: https://github.com/edenhill/librdkafka/blob/8bacbc0b4c357193288c81277bfcc815633126ea/INTRODUCTION.md#latency-measurement
    Details -> Maybe UTCTime
logAppendTime :: Maybe Clock.UTCTime,
    -- | Zero-based counter indicating the how-manyth time it is we're attemping
    -- to process this message.
    Details -> Maybe Int
processAttempt :: Maybe Int,
    -- | The amount of partitions for this topic the consumer is responsible
    -- for.
    Details -> Maybe Int
assignedPartitions :: Maybe Int,
    -- | The amount of partitions this consumer currently has paused, because
    -- it's behing processing this partition.
    Details -> Maybe Int
pausedPartitions :: Maybe Int,
    -- | Time since last rebalance in s
    Details -> Maybe Float
timeSinceLastRebalance :: Maybe Float,
    -- | The request id of the http request that resulted in the enqueueing of
    -- the message that is now being processed by a worker.
    Details -> Maybe Text
requestId :: Maybe Text
  }
  deriving ((forall x. Details -> Rep Details x)
-> (forall x. Rep Details x -> Details) -> Generic Details
forall x. Rep Details x -> Details
forall x. Details -> Rep Details x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Details x -> Details
$cfrom :: forall x. Details -> Rep Details x
Generic)

-- | An empty details value to be modified by you.
emptyDetails :: Details
emptyDetails :: Details
emptyDetails =
  Details :: Maybe Text
-> Maybe Int
-> Maybe Text
-> Maybe Contents
-> Maybe UTCTime
-> Maybe UTCTime
-> Maybe Int
-> Maybe Int
-> Maybe Int
-> Maybe Float
-> Maybe Text
-> Details
Details
    { topic :: Maybe Text
topic = Maybe Text
forall a. Maybe a
Nothing,
      partitionId :: Maybe Int
partitionId = Maybe Int
forall a. Maybe a
Nothing,
      key :: Maybe Text
key = Maybe Text
forall a. Maybe a
Nothing,
      contents :: Maybe Contents
contents = Maybe Contents
forall a. Maybe a
Nothing,
      createTime :: Maybe UTCTime
createTime = Maybe UTCTime
forall a. Maybe a
Nothing,
      logAppendTime :: Maybe UTCTime
logAppendTime = Maybe UTCTime
forall a. Maybe a
Nothing,
      processAttempt :: Maybe Int
processAttempt = Maybe Int
forall a. Maybe a
Nothing,
      assignedPartitions :: Maybe Int
assignedPartitions = Maybe Int
forall a. Maybe a
Nothing,
      pausedPartitions :: Maybe Int
pausedPartitions = Maybe Int
forall a. Maybe a
Nothing,
      timeSinceLastRebalance :: Maybe Float
timeSinceLastRebalance = Maybe Float
forall a. Maybe a
Nothing,
      requestId :: Maybe Text
requestId = Maybe Text
forall a. Maybe a
Nothing
    }

instance Aeson.ToJSON Details where
  toJSON :: Details -> Value
toJSON = Options -> Details -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
Aeson.genericToJSON Options
options
  toEncoding :: Details -> Encoding
toEncoding = Options -> Details -> Encoding
forall a.
(Generic a, GToJSON' Encoding Zero (Rep a)) =>
Options -> a -> Encoding
Aeson.genericToEncoding Options
options

options :: Aeson.Options
options :: Options
options =
  Options
Aeson.defaultOptions
    { fieldLabelModifier :: String -> String
Aeson.fieldLabelModifier = Char -> String -> String
Aeson.camelTo2 Char
'_',
      omitNothingFields :: Bool
Aeson.omitNothingFields = Bool
True
    }

instance Platform.TracingSpanDetails Details

-- | The contents of a Kafka message. Use 'mkContents' to create one of these.
data Contents where
  Contents :: (Aeson.ToJSON a) => a -> Contents

instance Aeson.ToJSON Contents where
  toJSON :: Contents -> Value
toJSON (Contents a
x) = a -> Value
forall a. ToJSON a => a -> Value
Aeson.toJSON a
x
  toEncoding :: Contents -> Encoding
toEncoding (Contents a
x) = a -> Encoding
forall a. ToJSON a => a -> Encoding
Aeson.toEncoding a
x

-- | Create a 'Contents' value.
--
-- The type wrapped needs to have an Aeson.ToJSON instance, so we can present it
-- nicely in observability tools.
--
-- > data MyMessagePayload { counter :: Int } deriving (Generic)
-- > instance Aeson.ToJSON MyMessagePayload
-- >
-- > contents = mkContents MyMessagePayload { counter = 5 }
mkContents :: Aeson.ToJSON a => a -> Contents
mkContents :: a -> Contents
mkContents = a -> Contents
forall a. ToJSON a => a -> Contents
Contents