{-# LANGUAGE DeriveDataTypeable         #-}
{-# LANGUAGE DeriveGeneric              #-}
{-# LANGUAGE DerivingStrategies         #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}

-----------------------------------------------------------------------------
-- |
-- Module holding producer types.
-----------------------------------------------------------------------------
module Kafka.Producer.Types
( KafkaProducer(..)
, ProducerRecord(..)
, ProducePartition(..)
, DeliveryReport(..)
, ImmediateError(..)
)
where

import Data.ByteString
import Data.Typeable        (Typeable)
import GHC.Generics         (Generic)
import Kafka.Consumer.Types (Offset (..))
import Kafka.Internal.Setup (HasKafka (..), HasKafkaConf (..), HasTopicConf (..), Kafka (..), KafkaConf (..), TopicConf (..))
import Kafka.Types          (KafkaError (..), TopicName (..), Headers)

-- | The main type for Kafka message production, used e.g. to send messages.
--
-- Its constructor is intentionally not exposed, instead, one should used 'Kafka.Producer.newProducer' to acquire such a value.
data KafkaProducer = KafkaProducer
  { KafkaProducer -> Kafka
kpKafkaPtr  :: !Kafka
  , KafkaProducer -> KafkaConf
kpKafkaConf :: !KafkaConf
  , KafkaProducer -> TopicConf
kpTopicConf :: !TopicConf
  }

instance HasKafka KafkaProducer where
  getKafka :: KafkaProducer -> Kafka
getKafka = KafkaProducer -> Kafka
kpKafkaPtr
  {-# INLINE getKafka #-}

instance HasKafkaConf KafkaProducer where
  getKafkaConf :: KafkaProducer -> KafkaConf
getKafkaConf = KafkaProducer -> KafkaConf
kpKafkaConf
  {-# INLINE getKafkaConf #-}

instance HasTopicConf KafkaProducer where
  getTopicConf :: KafkaProducer -> TopicConf
getTopicConf = KafkaProducer -> TopicConf
kpTopicConf
  {-# INLINE getTopicConf #-}

-- | Represents messages /to be enqueued/ onto a Kafka broker (i.e. used for a producer)
data ProducerRecord = ProducerRecord
  { ProducerRecord -> TopicName
prTopic     :: !TopicName
  , ProducerRecord -> ProducePartition
prPartition :: !ProducePartition
  , ProducerRecord -> Maybe ByteString
prKey       :: Maybe ByteString
  , ProducerRecord -> Maybe ByteString
prValue     :: Maybe ByteString
  , ProducerRecord -> Headers
prHeaders   :: !Headers
  } deriving (ProducerRecord -> ProducerRecord -> Bool
(ProducerRecord -> ProducerRecord -> Bool)
-> (ProducerRecord -> ProducerRecord -> Bool) -> Eq ProducerRecord
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ProducerRecord -> ProducerRecord -> Bool
$c/= :: ProducerRecord -> ProducerRecord -> Bool
== :: ProducerRecord -> ProducerRecord -> Bool
$c== :: ProducerRecord -> ProducerRecord -> Bool
Eq, Int -> ProducerRecord -> ShowS
[ProducerRecord] -> ShowS
ProducerRecord -> String
(Int -> ProducerRecord -> ShowS)
-> (ProducerRecord -> String)
-> ([ProducerRecord] -> ShowS)
-> Show ProducerRecord
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ProducerRecord] -> ShowS
$cshowList :: [ProducerRecord] -> ShowS
show :: ProducerRecord -> String
$cshow :: ProducerRecord -> String
showsPrec :: Int -> ProducerRecord -> ShowS
$cshowsPrec :: Int -> ProducerRecord -> ShowS
Show, Typeable, (forall x. ProducerRecord -> Rep ProducerRecord x)
-> (forall x. Rep ProducerRecord x -> ProducerRecord)
-> Generic ProducerRecord
forall x. Rep ProducerRecord x -> ProducerRecord
forall x. ProducerRecord -> Rep ProducerRecord x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ProducerRecord x -> ProducerRecord
$cfrom :: forall x. ProducerRecord -> Rep ProducerRecord x
Generic)

-- | 
data ProducePartition =
    -- | The partition number of the topic
    SpecifiedPartition {-# UNPACK #-} !Int
    -- | Let the Kafka broker decide the partition
  | UnassignedPartition
  deriving (Int -> ProducePartition -> ShowS
[ProducePartition] -> ShowS
ProducePartition -> String
(Int -> ProducePartition -> ShowS)
-> (ProducePartition -> String)
-> ([ProducePartition] -> ShowS)
-> Show ProducePartition
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ProducePartition] -> ShowS
$cshowList :: [ProducePartition] -> ShowS
show :: ProducePartition -> String
$cshow :: ProducePartition -> String
showsPrec :: Int -> ProducePartition -> ShowS
$cshowsPrec :: Int -> ProducePartition -> ShowS
Show, ProducePartition -> ProducePartition -> Bool
(ProducePartition -> ProducePartition -> Bool)
-> (ProducePartition -> ProducePartition -> Bool)
-> Eq ProducePartition
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ProducePartition -> ProducePartition -> Bool
$c/= :: ProducePartition -> ProducePartition -> Bool
== :: ProducePartition -> ProducePartition -> Bool
$c== :: ProducePartition -> ProducePartition -> Bool
Eq, Eq ProducePartition
Eq ProducePartition =>
(ProducePartition -> ProducePartition -> Ordering)
-> (ProducePartition -> ProducePartition -> Bool)
-> (ProducePartition -> ProducePartition -> Bool)
-> (ProducePartition -> ProducePartition -> Bool)
-> (ProducePartition -> ProducePartition -> Bool)
-> (ProducePartition -> ProducePartition -> ProducePartition)
-> (ProducePartition -> ProducePartition -> ProducePartition)
-> Ord ProducePartition
ProducePartition -> ProducePartition -> Bool
ProducePartition -> ProducePartition -> Ordering
ProducePartition -> ProducePartition -> ProducePartition
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 :: ProducePartition -> ProducePartition -> ProducePartition
$cmin :: ProducePartition -> ProducePartition -> ProducePartition
max :: ProducePartition -> ProducePartition -> ProducePartition
$cmax :: ProducePartition -> ProducePartition -> ProducePartition
>= :: ProducePartition -> ProducePartition -> Bool
$c>= :: ProducePartition -> ProducePartition -> Bool
> :: ProducePartition -> ProducePartition -> Bool
$c> :: ProducePartition -> ProducePartition -> Bool
<= :: ProducePartition -> ProducePartition -> Bool
$c<= :: ProducePartition -> ProducePartition -> Bool
< :: ProducePartition -> ProducePartition -> Bool
$c< :: ProducePartition -> ProducePartition -> Bool
compare :: ProducePartition -> ProducePartition -> Ordering
$ccompare :: ProducePartition -> ProducePartition -> Ordering
$cp1Ord :: Eq ProducePartition
Ord, Typeable, (forall x. ProducePartition -> Rep ProducePartition x)
-> (forall x. Rep ProducePartition x -> ProducePartition)
-> Generic ProducePartition
forall x. Rep ProducePartition x -> ProducePartition
forall x. ProducePartition -> Rep ProducePartition x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ProducePartition x -> ProducePartition
$cfrom :: forall x. ProducePartition -> Rep ProducePartition x
Generic)

-- | Data type representing an error that is caused by pre-flight conditions not being met
newtype ImmediateError = ImmediateError KafkaError
  deriving newtype (ImmediateError -> ImmediateError -> Bool
(ImmediateError -> ImmediateError -> Bool)
-> (ImmediateError -> ImmediateError -> Bool) -> Eq ImmediateError
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ImmediateError -> ImmediateError -> Bool
$c/= :: ImmediateError -> ImmediateError -> Bool
== :: ImmediateError -> ImmediateError -> Bool
$c== :: ImmediateError -> ImmediateError -> Bool
Eq, Int -> ImmediateError -> ShowS
[ImmediateError] -> ShowS
ImmediateError -> String
(Int -> ImmediateError -> ShowS)
-> (ImmediateError -> String)
-> ([ImmediateError] -> ShowS)
-> Show ImmediateError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ImmediateError] -> ShowS
$cshowList :: [ImmediateError] -> ShowS
show :: ImmediateError -> String
$cshow :: ImmediateError -> String
showsPrec :: Int -> ImmediateError -> ShowS
$cshowsPrec :: Int -> ImmediateError -> ShowS
Show)

-- | The result of sending a message to the broker, useful for callbacks
data DeliveryReport
    -- | The message was successfully sent at this offset
  = DeliverySuccess ProducerRecord Offset
    -- | The message could not be sent
  | DeliveryFailure ProducerRecord KafkaError
    -- | An error occurred, but /librdkafka/ did not attach any sent message
  | NoMessageError KafkaError
  deriving (Int -> DeliveryReport -> ShowS
[DeliveryReport] -> ShowS
DeliveryReport -> String
(Int -> DeliveryReport -> ShowS)
-> (DeliveryReport -> String)
-> ([DeliveryReport] -> ShowS)
-> Show DeliveryReport
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DeliveryReport] -> ShowS
$cshowList :: [DeliveryReport] -> ShowS
show :: DeliveryReport -> String
$cshow :: DeliveryReport -> String
showsPrec :: Int -> DeliveryReport -> ShowS
$cshowsPrec :: Int -> DeliveryReport -> ShowS
Show, DeliveryReport -> DeliveryReport -> Bool
(DeliveryReport -> DeliveryReport -> Bool)
-> (DeliveryReport -> DeliveryReport -> Bool) -> Eq DeliveryReport
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DeliveryReport -> DeliveryReport -> Bool
$c/= :: DeliveryReport -> DeliveryReport -> Bool
== :: DeliveryReport -> DeliveryReport -> Bool
$c== :: DeliveryReport -> DeliveryReport -> Bool
Eq, (forall x. DeliveryReport -> Rep DeliveryReport x)
-> (forall x. Rep DeliveryReport x -> DeliveryReport)
-> Generic DeliveryReport
forall x. Rep DeliveryReport x -> DeliveryReport
forall x. DeliveryReport -> Rep DeliveryReport x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep DeliveryReport x -> DeliveryReport
$cfrom :: forall x. DeliveryReport -> Rep DeliveryReport x
Generic)