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

-----------------------------------------------------------------------------
-- |
-- Module holding types shared by consumer and producer modules.
-----------------------------------------------------------------------------
module Kafka.Types
( BrokerId(..)
, PartitionId(..)
, Millis(..)
, ClientId(..)
, BatchSize(..)
, TopicName(..)
, BrokerAddress(..)
, Timeout(..)
, KafkaLogLevel(..)
, KafkaError(..)
, KafkaDebug(..)
, KafkaCompressionCodec(..)
, TopicType(..)
, topicType
, kafkaDebugToText
, kafkaCompressionCodecToText
)
where

import Control.Exception      (Exception (..))
import Data.Int               (Int64)
import Data.String            (IsString)
import Data.Text              (Text, isPrefixOf)
import Data.Typeable          (Typeable)
import GHC.Generics           (Generic)
import Kafka.Internal.RdKafka (RdKafkaRespErrT, rdKafkaErr2name, rdKafkaErr2str)

-- | Kafka broker ID
newtype BrokerId = BrokerId { BrokerId -> Int
unBrokerId :: Int } deriving (Int -> BrokerId -> ShowS
[BrokerId] -> ShowS
BrokerId -> String
(Int -> BrokerId -> ShowS)
-> (BrokerId -> String) -> ([BrokerId] -> ShowS) -> Show BrokerId
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [BrokerId] -> ShowS
$cshowList :: [BrokerId] -> ShowS
show :: BrokerId -> String
$cshow :: BrokerId -> String
showsPrec :: Int -> BrokerId -> ShowS
$cshowsPrec :: Int -> BrokerId -> ShowS
Show, BrokerId -> BrokerId -> Bool
(BrokerId -> BrokerId -> Bool)
-> (BrokerId -> BrokerId -> Bool) -> Eq BrokerId
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: BrokerId -> BrokerId -> Bool
$c/= :: BrokerId -> BrokerId -> Bool
== :: BrokerId -> BrokerId -> Bool
$c== :: BrokerId -> BrokerId -> Bool
Eq, Eq BrokerId
Eq BrokerId =>
(BrokerId -> BrokerId -> Ordering)
-> (BrokerId -> BrokerId -> Bool)
-> (BrokerId -> BrokerId -> Bool)
-> (BrokerId -> BrokerId -> Bool)
-> (BrokerId -> BrokerId -> Bool)
-> (BrokerId -> BrokerId -> BrokerId)
-> (BrokerId -> BrokerId -> BrokerId)
-> Ord BrokerId
BrokerId -> BrokerId -> Bool
BrokerId -> BrokerId -> Ordering
BrokerId -> BrokerId -> BrokerId
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 :: BrokerId -> BrokerId -> BrokerId
$cmin :: BrokerId -> BrokerId -> BrokerId
max :: BrokerId -> BrokerId -> BrokerId
$cmax :: BrokerId -> BrokerId -> BrokerId
>= :: BrokerId -> BrokerId -> Bool
$c>= :: BrokerId -> BrokerId -> Bool
> :: BrokerId -> BrokerId -> Bool
$c> :: BrokerId -> BrokerId -> Bool
<= :: BrokerId -> BrokerId -> Bool
$c<= :: BrokerId -> BrokerId -> Bool
< :: BrokerId -> BrokerId -> Bool
$c< :: BrokerId -> BrokerId -> Bool
compare :: BrokerId -> BrokerId -> Ordering
$ccompare :: BrokerId -> BrokerId -> Ordering
$cp1Ord :: Eq BrokerId
Ord, ReadPrec [BrokerId]
ReadPrec BrokerId
Int -> ReadS BrokerId
ReadS [BrokerId]
(Int -> ReadS BrokerId)
-> ReadS [BrokerId]
-> ReadPrec BrokerId
-> ReadPrec [BrokerId]
-> Read BrokerId
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [BrokerId]
$creadListPrec :: ReadPrec [BrokerId]
readPrec :: ReadPrec BrokerId
$creadPrec :: ReadPrec BrokerId
readList :: ReadS [BrokerId]
$creadList :: ReadS [BrokerId]
readsPrec :: Int -> ReadS BrokerId
$creadsPrec :: Int -> ReadS BrokerId
Read, (forall x. BrokerId -> Rep BrokerId x)
-> (forall x. Rep BrokerId x -> BrokerId) -> Generic BrokerId
forall x. Rep BrokerId x -> BrokerId
forall x. BrokerId -> Rep BrokerId x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep BrokerId x -> BrokerId
$cfrom :: forall x. BrokerId -> Rep BrokerId x
Generic)

-- | Topic partition ID
newtype PartitionId = PartitionId { PartitionId -> Int
unPartitionId :: Int } deriving (Int -> PartitionId -> ShowS
[PartitionId] -> ShowS
PartitionId -> String
(Int -> PartitionId -> ShowS)
-> (PartitionId -> String)
-> ([PartitionId] -> ShowS)
-> Show PartitionId
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PartitionId] -> ShowS
$cshowList :: [PartitionId] -> ShowS
show :: PartitionId -> String
$cshow :: PartitionId -> String
showsPrec :: Int -> PartitionId -> ShowS
$cshowsPrec :: Int -> PartitionId -> ShowS
Show, PartitionId -> PartitionId -> Bool
(PartitionId -> PartitionId -> Bool)
-> (PartitionId -> PartitionId -> Bool) -> Eq PartitionId
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PartitionId -> PartitionId -> Bool
$c/= :: PartitionId -> PartitionId -> Bool
== :: PartitionId -> PartitionId -> Bool
$c== :: PartitionId -> PartitionId -> Bool
Eq, ReadPrec [PartitionId]
ReadPrec PartitionId
Int -> ReadS PartitionId
ReadS [PartitionId]
(Int -> ReadS PartitionId)
-> ReadS [PartitionId]
-> ReadPrec PartitionId
-> ReadPrec [PartitionId]
-> Read PartitionId
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [PartitionId]
$creadListPrec :: ReadPrec [PartitionId]
readPrec :: ReadPrec PartitionId
$creadPrec :: ReadPrec PartitionId
readList :: ReadS [PartitionId]
$creadList :: ReadS [PartitionId]
readsPrec :: Int -> ReadS PartitionId
$creadsPrec :: Int -> ReadS PartitionId
Read, Eq PartitionId
Eq PartitionId =>
(PartitionId -> PartitionId -> Ordering)
-> (PartitionId -> PartitionId -> Bool)
-> (PartitionId -> PartitionId -> Bool)
-> (PartitionId -> PartitionId -> Bool)
-> (PartitionId -> PartitionId -> Bool)
-> (PartitionId -> PartitionId -> PartitionId)
-> (PartitionId -> PartitionId -> PartitionId)
-> Ord PartitionId
PartitionId -> PartitionId -> Bool
PartitionId -> PartitionId -> Ordering
PartitionId -> PartitionId -> PartitionId
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 :: PartitionId -> PartitionId -> PartitionId
$cmin :: PartitionId -> PartitionId -> PartitionId
max :: PartitionId -> PartitionId -> PartitionId
$cmax :: PartitionId -> PartitionId -> PartitionId
>= :: PartitionId -> PartitionId -> Bool
$c>= :: PartitionId -> PartitionId -> Bool
> :: PartitionId -> PartitionId -> Bool
$c> :: PartitionId -> PartitionId -> Bool
<= :: PartitionId -> PartitionId -> Bool
$c<= :: PartitionId -> PartitionId -> Bool
< :: PartitionId -> PartitionId -> Bool
$c< :: PartitionId -> PartitionId -> Bool
compare :: PartitionId -> PartitionId -> Ordering
$ccompare :: PartitionId -> PartitionId -> Ordering
$cp1Ord :: Eq PartitionId
Ord, Int -> PartitionId
PartitionId -> Int
PartitionId -> [PartitionId]
PartitionId -> PartitionId
PartitionId -> PartitionId -> [PartitionId]
PartitionId -> PartitionId -> PartitionId -> [PartitionId]
(PartitionId -> PartitionId)
-> (PartitionId -> PartitionId)
-> (Int -> PartitionId)
-> (PartitionId -> Int)
-> (PartitionId -> [PartitionId])
-> (PartitionId -> PartitionId -> [PartitionId])
-> (PartitionId -> PartitionId -> [PartitionId])
-> (PartitionId -> PartitionId -> PartitionId -> [PartitionId])
-> Enum PartitionId
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 :: PartitionId -> PartitionId -> PartitionId -> [PartitionId]
$cenumFromThenTo :: PartitionId -> PartitionId -> PartitionId -> [PartitionId]
enumFromTo :: PartitionId -> PartitionId -> [PartitionId]
$cenumFromTo :: PartitionId -> PartitionId -> [PartitionId]
enumFromThen :: PartitionId -> PartitionId -> [PartitionId]
$cenumFromThen :: PartitionId -> PartitionId -> [PartitionId]
enumFrom :: PartitionId -> [PartitionId]
$cenumFrom :: PartitionId -> [PartitionId]
fromEnum :: PartitionId -> Int
$cfromEnum :: PartitionId -> Int
toEnum :: Int -> PartitionId
$ctoEnum :: Int -> PartitionId
pred :: PartitionId -> PartitionId
$cpred :: PartitionId -> PartitionId
succ :: PartitionId -> PartitionId
$csucc :: PartitionId -> PartitionId
Enum, (forall x. PartitionId -> Rep PartitionId x)
-> (forall x. Rep PartitionId x -> PartitionId)
-> Generic PartitionId
forall x. Rep PartitionId x -> PartitionId
forall x. PartitionId -> Rep PartitionId x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep PartitionId x -> PartitionId
$cfrom :: forall x. PartitionId -> Rep PartitionId x
Generic)

-- | A number of milliseconds, used to represent durations and timestamps
newtype Millis      = Millis { Millis -> Int64
unMillis :: Int64 } deriving (Int -> Millis -> ShowS
[Millis] -> ShowS
Millis -> String
(Int -> Millis -> ShowS)
-> (Millis -> String) -> ([Millis] -> ShowS) -> Show Millis
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Millis] -> ShowS
$cshowList :: [Millis] -> ShowS
show :: Millis -> String
$cshow :: Millis -> String
showsPrec :: Int -> Millis -> ShowS
$cshowsPrec :: Int -> Millis -> ShowS
Show, ReadPrec [Millis]
ReadPrec Millis
Int -> ReadS Millis
ReadS [Millis]
(Int -> ReadS Millis)
-> ReadS [Millis]
-> ReadPrec Millis
-> ReadPrec [Millis]
-> Read Millis
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Millis]
$creadListPrec :: ReadPrec [Millis]
readPrec :: ReadPrec Millis
$creadPrec :: ReadPrec Millis
readList :: ReadS [Millis]
$creadList :: ReadS [Millis]
readsPrec :: Int -> ReadS Millis
$creadsPrec :: Int -> ReadS Millis
Read, Millis -> Millis -> Bool
(Millis -> Millis -> Bool)
-> (Millis -> Millis -> Bool) -> Eq Millis
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Millis -> Millis -> Bool
$c/= :: Millis -> Millis -> Bool
== :: Millis -> Millis -> Bool
$c== :: Millis -> Millis -> Bool
Eq, Eq Millis
Eq Millis =>
(Millis -> Millis -> Ordering)
-> (Millis -> Millis -> Bool)
-> (Millis -> Millis -> Bool)
-> (Millis -> Millis -> Bool)
-> (Millis -> Millis -> Bool)
-> (Millis -> Millis -> Millis)
-> (Millis -> Millis -> Millis)
-> Ord Millis
Millis -> Millis -> Bool
Millis -> Millis -> Ordering
Millis -> Millis -> Millis
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 :: Millis -> Millis -> Millis
$cmin :: Millis -> Millis -> Millis
max :: Millis -> Millis -> Millis
$cmax :: Millis -> Millis -> Millis
>= :: Millis -> Millis -> Bool
$c>= :: Millis -> Millis -> Bool
> :: Millis -> Millis -> Bool
$c> :: Millis -> Millis -> Bool
<= :: Millis -> Millis -> Bool
$c<= :: Millis -> Millis -> Bool
< :: Millis -> Millis -> Bool
$c< :: Millis -> Millis -> Bool
compare :: Millis -> Millis -> Ordering
$ccompare :: Millis -> Millis -> Ordering
$cp1Ord :: Eq Millis
Ord, Integer -> Millis
Millis -> Millis
Millis -> Millis -> Millis
(Millis -> Millis -> Millis)
-> (Millis -> Millis -> Millis)
-> (Millis -> Millis -> Millis)
-> (Millis -> Millis)
-> (Millis -> Millis)
-> (Millis -> Millis)
-> (Integer -> Millis)
-> Num Millis
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
fromInteger :: Integer -> Millis
$cfromInteger :: Integer -> Millis
signum :: Millis -> Millis
$csignum :: Millis -> Millis
abs :: Millis -> Millis
$cabs :: Millis -> Millis
negate :: Millis -> Millis
$cnegate :: Millis -> Millis
* :: Millis -> Millis -> Millis
$c* :: Millis -> Millis -> Millis
- :: Millis -> Millis -> Millis
$c- :: Millis -> Millis -> Millis
+ :: Millis -> Millis -> Millis
$c+ :: Millis -> Millis -> Millis
Num, (forall x. Millis -> Rep Millis x)
-> (forall x. Rep Millis x -> Millis) -> Generic Millis
forall x. Rep Millis x -> Millis
forall x. Millis -> Rep Millis x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Millis x -> Millis
$cfrom :: forall x. Millis -> Rep Millis x
Generic)

-- | Client ID used by Kafka to better track requests
-- 
-- See <https://kafka.apache.org/documentation/#client.id Kafka documentation on client ID>
newtype ClientId = ClientId
  { ClientId -> Text
unClientId :: Text
  } deriving (Int -> ClientId -> ShowS
[ClientId] -> ShowS
ClientId -> String
(Int -> ClientId -> ShowS)
-> (ClientId -> String) -> ([ClientId] -> ShowS) -> Show ClientId
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ClientId] -> ShowS
$cshowList :: [ClientId] -> ShowS
show :: ClientId -> String
$cshow :: ClientId -> String
showsPrec :: Int -> ClientId -> ShowS
$cshowsPrec :: Int -> ClientId -> ShowS
Show, ClientId -> ClientId -> Bool
(ClientId -> ClientId -> Bool)
-> (ClientId -> ClientId -> Bool) -> Eq ClientId
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ClientId -> ClientId -> Bool
$c/= :: ClientId -> ClientId -> Bool
== :: ClientId -> ClientId -> Bool
$c== :: ClientId -> ClientId -> Bool
Eq, String -> ClientId
(String -> ClientId) -> IsString ClientId
forall a. (String -> a) -> IsString a
fromString :: String -> ClientId
$cfromString :: String -> ClientId
IsString, Eq ClientId
Eq ClientId =>
(ClientId -> ClientId -> Ordering)
-> (ClientId -> ClientId -> Bool)
-> (ClientId -> ClientId -> Bool)
-> (ClientId -> ClientId -> Bool)
-> (ClientId -> ClientId -> Bool)
-> (ClientId -> ClientId -> ClientId)
-> (ClientId -> ClientId -> ClientId)
-> Ord ClientId
ClientId -> ClientId -> Bool
ClientId -> ClientId -> Ordering
ClientId -> ClientId -> ClientId
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 :: ClientId -> ClientId -> ClientId
$cmin :: ClientId -> ClientId -> ClientId
max :: ClientId -> ClientId -> ClientId
$cmax :: ClientId -> ClientId -> ClientId
>= :: ClientId -> ClientId -> Bool
$c>= :: ClientId -> ClientId -> Bool
> :: ClientId -> ClientId -> Bool
$c> :: ClientId -> ClientId -> Bool
<= :: ClientId -> ClientId -> Bool
$c<= :: ClientId -> ClientId -> Bool
< :: ClientId -> ClientId -> Bool
$c< :: ClientId -> ClientId -> Bool
compare :: ClientId -> ClientId -> Ordering
$ccompare :: ClientId -> ClientId -> Ordering
$cp1Ord :: Eq ClientId
Ord, (forall x. ClientId -> Rep ClientId x)
-> (forall x. Rep ClientId x -> ClientId) -> Generic ClientId
forall x. Rep ClientId x -> ClientId
forall x. ClientId -> Rep ClientId x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ClientId x -> ClientId
$cfrom :: forall x. ClientId -> Rep ClientId x
Generic)

-- | Batch size used for polling
newtype BatchSize   = BatchSize { BatchSize -> Int
unBatchSize :: Int } deriving (Int -> BatchSize -> ShowS
[BatchSize] -> ShowS
BatchSize -> String
(Int -> BatchSize -> ShowS)
-> (BatchSize -> String)
-> ([BatchSize] -> ShowS)
-> Show BatchSize
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [BatchSize] -> ShowS
$cshowList :: [BatchSize] -> ShowS
show :: BatchSize -> String
$cshow :: BatchSize -> String
showsPrec :: Int -> BatchSize -> ShowS
$cshowsPrec :: Int -> BatchSize -> ShowS
Show, ReadPrec [BatchSize]
ReadPrec BatchSize
Int -> ReadS BatchSize
ReadS [BatchSize]
(Int -> ReadS BatchSize)
-> ReadS [BatchSize]
-> ReadPrec BatchSize
-> ReadPrec [BatchSize]
-> Read BatchSize
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [BatchSize]
$creadListPrec :: ReadPrec [BatchSize]
readPrec :: ReadPrec BatchSize
$creadPrec :: ReadPrec BatchSize
readList :: ReadS [BatchSize]
$creadList :: ReadS [BatchSize]
readsPrec :: Int -> ReadS BatchSize
$creadsPrec :: Int -> ReadS BatchSize
Read, BatchSize -> BatchSize -> Bool
(BatchSize -> BatchSize -> Bool)
-> (BatchSize -> BatchSize -> Bool) -> Eq BatchSize
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: BatchSize -> BatchSize -> Bool
$c/= :: BatchSize -> BatchSize -> Bool
== :: BatchSize -> BatchSize -> Bool
$c== :: BatchSize -> BatchSize -> Bool
Eq, Eq BatchSize
Eq BatchSize =>
(BatchSize -> BatchSize -> Ordering)
-> (BatchSize -> BatchSize -> Bool)
-> (BatchSize -> BatchSize -> Bool)
-> (BatchSize -> BatchSize -> Bool)
-> (BatchSize -> BatchSize -> Bool)
-> (BatchSize -> BatchSize -> BatchSize)
-> (BatchSize -> BatchSize -> BatchSize)
-> Ord BatchSize
BatchSize -> BatchSize -> Bool
BatchSize -> BatchSize -> Ordering
BatchSize -> BatchSize -> BatchSize
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 :: BatchSize -> BatchSize -> BatchSize
$cmin :: BatchSize -> BatchSize -> BatchSize
max :: BatchSize -> BatchSize -> BatchSize
$cmax :: BatchSize -> BatchSize -> BatchSize
>= :: BatchSize -> BatchSize -> Bool
$c>= :: BatchSize -> BatchSize -> Bool
> :: BatchSize -> BatchSize -> Bool
$c> :: BatchSize -> BatchSize -> Bool
<= :: BatchSize -> BatchSize -> Bool
$c<= :: BatchSize -> BatchSize -> Bool
< :: BatchSize -> BatchSize -> Bool
$c< :: BatchSize -> BatchSize -> Bool
compare :: BatchSize -> BatchSize -> Ordering
$ccompare :: BatchSize -> BatchSize -> Ordering
$cp1Ord :: Eq BatchSize
Ord, Integer -> BatchSize
BatchSize -> BatchSize
BatchSize -> BatchSize -> BatchSize
(BatchSize -> BatchSize -> BatchSize)
-> (BatchSize -> BatchSize -> BatchSize)
-> (BatchSize -> BatchSize -> BatchSize)
-> (BatchSize -> BatchSize)
-> (BatchSize -> BatchSize)
-> (BatchSize -> BatchSize)
-> (Integer -> BatchSize)
-> Num BatchSize
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
fromInteger :: Integer -> BatchSize
$cfromInteger :: Integer -> BatchSize
signum :: BatchSize -> BatchSize
$csignum :: BatchSize -> BatchSize
abs :: BatchSize -> BatchSize
$cabs :: BatchSize -> BatchSize
negate :: BatchSize -> BatchSize
$cnegate :: BatchSize -> BatchSize
* :: BatchSize -> BatchSize -> BatchSize
$c* :: BatchSize -> BatchSize -> BatchSize
- :: BatchSize -> BatchSize -> BatchSize
$c- :: BatchSize -> BatchSize -> BatchSize
+ :: BatchSize -> BatchSize -> BatchSize
$c+ :: BatchSize -> BatchSize -> BatchSize
Num, (forall x. BatchSize -> Rep BatchSize x)
-> (forall x. Rep BatchSize x -> BatchSize) -> Generic BatchSize
forall x. Rep BatchSize x -> BatchSize
forall x. BatchSize -> Rep BatchSize x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep BatchSize x -> BatchSize
$cfrom :: forall x. BatchSize -> Rep BatchSize x
Generic)

-- | Whether the topic is created by a user or by the system
data TopicType =
    User    -- ^ Normal topics that are created by user.
  | System  -- ^ Topics starting with a double underscore "\__" (@__consumer_offsets@, @__confluent.support.metrics@, etc.) are considered "system" topics
  deriving (Int -> TopicType -> ShowS
[TopicType] -> ShowS
TopicType -> String
(Int -> TopicType -> ShowS)
-> (TopicType -> String)
-> ([TopicType] -> ShowS)
-> Show TopicType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TopicType] -> ShowS
$cshowList :: [TopicType] -> ShowS
show :: TopicType -> String
$cshow :: TopicType -> String
showsPrec :: Int -> TopicType -> ShowS
$cshowsPrec :: Int -> TopicType -> ShowS
Show, ReadPrec [TopicType]
ReadPrec TopicType
Int -> ReadS TopicType
ReadS [TopicType]
(Int -> ReadS TopicType)
-> ReadS [TopicType]
-> ReadPrec TopicType
-> ReadPrec [TopicType]
-> Read TopicType
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [TopicType]
$creadListPrec :: ReadPrec [TopicType]
readPrec :: ReadPrec TopicType
$creadPrec :: ReadPrec TopicType
readList :: ReadS [TopicType]
$creadList :: ReadS [TopicType]
readsPrec :: Int -> ReadS TopicType
$creadsPrec :: Int -> ReadS TopicType
Read, TopicType -> TopicType -> Bool
(TopicType -> TopicType -> Bool)
-> (TopicType -> TopicType -> Bool) -> Eq TopicType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TopicType -> TopicType -> Bool
$c/= :: TopicType -> TopicType -> Bool
== :: TopicType -> TopicType -> Bool
$c== :: TopicType -> TopicType -> Bool
Eq, Eq TopicType
Eq TopicType =>
(TopicType -> TopicType -> Ordering)
-> (TopicType -> TopicType -> Bool)
-> (TopicType -> TopicType -> Bool)
-> (TopicType -> TopicType -> Bool)
-> (TopicType -> TopicType -> Bool)
-> (TopicType -> TopicType -> TopicType)
-> (TopicType -> TopicType -> TopicType)
-> Ord TopicType
TopicType -> TopicType -> Bool
TopicType -> TopicType -> Ordering
TopicType -> TopicType -> TopicType
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 :: TopicType -> TopicType -> TopicType
$cmin :: TopicType -> TopicType -> TopicType
max :: TopicType -> TopicType -> TopicType
$cmax :: TopicType -> TopicType -> TopicType
>= :: TopicType -> TopicType -> Bool
$c>= :: TopicType -> TopicType -> Bool
> :: TopicType -> TopicType -> Bool
$c> :: TopicType -> TopicType -> Bool
<= :: TopicType -> TopicType -> Bool
$c<= :: TopicType -> TopicType -> Bool
< :: TopicType -> TopicType -> Bool
$c< :: TopicType -> TopicType -> Bool
compare :: TopicType -> TopicType -> Ordering
$ccompare :: TopicType -> TopicType -> Ordering
$cp1Ord :: Eq TopicType
Ord, (forall x. TopicType -> Rep TopicType x)
-> (forall x. Rep TopicType x -> TopicType) -> Generic TopicType
forall x. Rep TopicType x -> TopicType
forall x. TopicType -> Rep TopicType x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep TopicType x -> TopicType
$cfrom :: forall x. TopicType -> Rep TopicType x
Generic)

-- | Topic name to consume/produce messages
--
-- Wildcard (regex) topics are supported by the /librdkafka/ assignor:
-- any topic name in the topics list that is prefixed with @^@ will
-- be regex-matched to the full list of topics in the cluster and matching
-- topics will be added to the subscription list.
newtype TopicName = TopicName
  { TopicName -> Text
unTopicName :: Text -- ^ a simple topic name or a regex if started with @^@
  } deriving (Int -> TopicName -> ShowS
[TopicName] -> ShowS
TopicName -> String
(Int -> TopicName -> ShowS)
-> (TopicName -> String)
-> ([TopicName] -> ShowS)
-> Show TopicName
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TopicName] -> ShowS
$cshowList :: [TopicName] -> ShowS
show :: TopicName -> String
$cshow :: TopicName -> String
showsPrec :: Int -> TopicName -> ShowS
$cshowsPrec :: Int -> TopicName -> ShowS
Show, TopicName -> TopicName -> Bool
(TopicName -> TopicName -> Bool)
-> (TopicName -> TopicName -> Bool) -> Eq TopicName
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TopicName -> TopicName -> Bool
$c/= :: TopicName -> TopicName -> Bool
== :: TopicName -> TopicName -> Bool
$c== :: TopicName -> TopicName -> Bool
Eq, Eq TopicName
Eq TopicName =>
(TopicName -> TopicName -> Ordering)
-> (TopicName -> TopicName -> Bool)
-> (TopicName -> TopicName -> Bool)
-> (TopicName -> TopicName -> Bool)
-> (TopicName -> TopicName -> Bool)
-> (TopicName -> TopicName -> TopicName)
-> (TopicName -> TopicName -> TopicName)
-> Ord TopicName
TopicName -> TopicName -> Bool
TopicName -> TopicName -> Ordering
TopicName -> TopicName -> TopicName
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 :: TopicName -> TopicName -> TopicName
$cmin :: TopicName -> TopicName -> TopicName
max :: TopicName -> TopicName -> TopicName
$cmax :: TopicName -> TopicName -> TopicName
>= :: TopicName -> TopicName -> Bool
$c>= :: TopicName -> TopicName -> Bool
> :: TopicName -> TopicName -> Bool
$c> :: TopicName -> TopicName -> Bool
<= :: TopicName -> TopicName -> Bool
$c<= :: TopicName -> TopicName -> Bool
< :: TopicName -> TopicName -> Bool
$c< :: TopicName -> TopicName -> Bool
compare :: TopicName -> TopicName -> Ordering
$ccompare :: TopicName -> TopicName -> Ordering
$cp1Ord :: Eq TopicName
Ord, String -> TopicName
(String -> TopicName) -> IsString TopicName
forall a. (String -> a) -> IsString a
fromString :: String -> TopicName
$cfromString :: String -> TopicName
IsString, ReadPrec [TopicName]
ReadPrec TopicName
Int -> ReadS TopicName
ReadS [TopicName]
(Int -> ReadS TopicName)
-> ReadS [TopicName]
-> ReadPrec TopicName
-> ReadPrec [TopicName]
-> Read TopicName
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [TopicName]
$creadListPrec :: ReadPrec [TopicName]
readPrec :: ReadPrec TopicName
$creadPrec :: ReadPrec TopicName
readList :: ReadS [TopicName]
$creadList :: ReadS [TopicName]
readsPrec :: Int -> ReadS TopicName
$creadsPrec :: Int -> ReadS TopicName
Read, (forall x. TopicName -> Rep TopicName x)
-> (forall x. Rep TopicName x -> TopicName) -> Generic TopicName
forall x. Rep TopicName x -> TopicName
forall x. TopicName -> Rep TopicName x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep TopicName x -> TopicName
$cfrom :: forall x. TopicName -> Rep TopicName x
Generic)

-- | Deduce the type of a topic from its name, by checking if it starts with a double underscore "\__"
topicType :: TopicName -> TopicType
topicType :: TopicName -> TopicType
topicType (TopicName tn :: Text
tn) =
  if "__" Text -> Text -> Bool
`isPrefixOf` Text
tn then TopicType
System else TopicType
User
{-# INLINE topicType #-}

-- | Kafka broker address string (e.g. @broker1:9092@)
newtype BrokerAddress = BrokerAddress
  { BrokerAddress -> Text
unBrokerAddress :: Text
  } deriving (Int -> BrokerAddress -> ShowS
[BrokerAddress] -> ShowS
BrokerAddress -> String
(Int -> BrokerAddress -> ShowS)
-> (BrokerAddress -> String)
-> ([BrokerAddress] -> ShowS)
-> Show BrokerAddress
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [BrokerAddress] -> ShowS
$cshowList :: [BrokerAddress] -> ShowS
show :: BrokerAddress -> String
$cshow :: BrokerAddress -> String
showsPrec :: Int -> BrokerAddress -> ShowS
$cshowsPrec :: Int -> BrokerAddress -> ShowS
Show, BrokerAddress -> BrokerAddress -> Bool
(BrokerAddress -> BrokerAddress -> Bool)
-> (BrokerAddress -> BrokerAddress -> Bool) -> Eq BrokerAddress
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: BrokerAddress -> BrokerAddress -> Bool
$c/= :: BrokerAddress -> BrokerAddress -> Bool
== :: BrokerAddress -> BrokerAddress -> Bool
$c== :: BrokerAddress -> BrokerAddress -> Bool
Eq, String -> BrokerAddress
(String -> BrokerAddress) -> IsString BrokerAddress
forall a. (String -> a) -> IsString a
fromString :: String -> BrokerAddress
$cfromString :: String -> BrokerAddress
IsString, (forall x. BrokerAddress -> Rep BrokerAddress x)
-> (forall x. Rep BrokerAddress x -> BrokerAddress)
-> Generic BrokerAddress
forall x. Rep BrokerAddress x -> BrokerAddress
forall x. BrokerAddress -> Rep BrokerAddress x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep BrokerAddress x -> BrokerAddress
$cfrom :: forall x. BrokerAddress -> Rep BrokerAddress x
Generic)

-- | Timeout in milliseconds
newtype Timeout = Timeout { Timeout -> Int
unTimeout :: Int } deriving (Int -> Timeout -> ShowS
[Timeout] -> ShowS
Timeout -> String
(Int -> Timeout -> ShowS)
-> (Timeout -> String) -> ([Timeout] -> ShowS) -> Show Timeout
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Timeout] -> ShowS
$cshowList :: [Timeout] -> ShowS
show :: Timeout -> String
$cshow :: Timeout -> String
showsPrec :: Int -> Timeout -> ShowS
$cshowsPrec :: Int -> Timeout -> ShowS
Show, Timeout -> Timeout -> Bool
(Timeout -> Timeout -> Bool)
-> (Timeout -> Timeout -> Bool) -> Eq Timeout
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Timeout -> Timeout -> Bool
$c/= :: Timeout -> Timeout -> Bool
== :: Timeout -> Timeout -> Bool
$c== :: Timeout -> Timeout -> Bool
Eq, ReadPrec [Timeout]
ReadPrec Timeout
Int -> ReadS Timeout
ReadS [Timeout]
(Int -> ReadS Timeout)
-> ReadS [Timeout]
-> ReadPrec Timeout
-> ReadPrec [Timeout]
-> Read Timeout
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Timeout]
$creadListPrec :: ReadPrec [Timeout]
readPrec :: ReadPrec Timeout
$creadPrec :: ReadPrec Timeout
readList :: ReadS [Timeout]
$creadList :: ReadS [Timeout]
readsPrec :: Int -> ReadS Timeout
$creadsPrec :: Int -> ReadS Timeout
Read, (forall x. Timeout -> Rep Timeout x)
-> (forall x. Rep Timeout x -> Timeout) -> Generic Timeout
forall x. Rep Timeout x -> Timeout
forall x. Timeout -> Rep Timeout x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Timeout x -> Timeout
$cfrom :: forall x. Timeout -> Rep Timeout x
Generic)

-- | Log levels for /librdkafka/.
data KafkaLogLevel =
  KafkaLogEmerg | KafkaLogAlert | KafkaLogCrit | KafkaLogErr | KafkaLogWarning |
  KafkaLogNotice | KafkaLogInfo | KafkaLogDebug
  deriving (Int -> KafkaLogLevel -> ShowS
[KafkaLogLevel] -> ShowS
KafkaLogLevel -> String
(Int -> KafkaLogLevel -> ShowS)
-> (KafkaLogLevel -> String)
-> ([KafkaLogLevel] -> ShowS)
-> Show KafkaLogLevel
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [KafkaLogLevel] -> ShowS
$cshowList :: [KafkaLogLevel] -> ShowS
show :: KafkaLogLevel -> String
$cshow :: KafkaLogLevel -> String
showsPrec :: Int -> KafkaLogLevel -> ShowS
$cshowsPrec :: Int -> KafkaLogLevel -> ShowS
Show, Int -> KafkaLogLevel
KafkaLogLevel -> Int
KafkaLogLevel -> [KafkaLogLevel]
KafkaLogLevel -> KafkaLogLevel
KafkaLogLevel -> KafkaLogLevel -> [KafkaLogLevel]
KafkaLogLevel -> KafkaLogLevel -> KafkaLogLevel -> [KafkaLogLevel]
(KafkaLogLevel -> KafkaLogLevel)
-> (KafkaLogLevel -> KafkaLogLevel)
-> (Int -> KafkaLogLevel)
-> (KafkaLogLevel -> Int)
-> (KafkaLogLevel -> [KafkaLogLevel])
-> (KafkaLogLevel -> KafkaLogLevel -> [KafkaLogLevel])
-> (KafkaLogLevel -> KafkaLogLevel -> [KafkaLogLevel])
-> (KafkaLogLevel
    -> KafkaLogLevel -> KafkaLogLevel -> [KafkaLogLevel])
-> Enum KafkaLogLevel
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 :: KafkaLogLevel -> KafkaLogLevel -> KafkaLogLevel -> [KafkaLogLevel]
$cenumFromThenTo :: KafkaLogLevel -> KafkaLogLevel -> KafkaLogLevel -> [KafkaLogLevel]
enumFromTo :: KafkaLogLevel -> KafkaLogLevel -> [KafkaLogLevel]
$cenumFromTo :: KafkaLogLevel -> KafkaLogLevel -> [KafkaLogLevel]
enumFromThen :: KafkaLogLevel -> KafkaLogLevel -> [KafkaLogLevel]
$cenumFromThen :: KafkaLogLevel -> KafkaLogLevel -> [KafkaLogLevel]
enumFrom :: KafkaLogLevel -> [KafkaLogLevel]
$cenumFrom :: KafkaLogLevel -> [KafkaLogLevel]
fromEnum :: KafkaLogLevel -> Int
$cfromEnum :: KafkaLogLevel -> Int
toEnum :: Int -> KafkaLogLevel
$ctoEnum :: Int -> KafkaLogLevel
pred :: KafkaLogLevel -> KafkaLogLevel
$cpred :: KafkaLogLevel -> KafkaLogLevel
succ :: KafkaLogLevel -> KafkaLogLevel
$csucc :: KafkaLogLevel -> KafkaLogLevel
Enum, KafkaLogLevel -> KafkaLogLevel -> Bool
(KafkaLogLevel -> KafkaLogLevel -> Bool)
-> (KafkaLogLevel -> KafkaLogLevel -> Bool) -> Eq KafkaLogLevel
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: KafkaLogLevel -> KafkaLogLevel -> Bool
$c/= :: KafkaLogLevel -> KafkaLogLevel -> Bool
== :: KafkaLogLevel -> KafkaLogLevel -> Bool
$c== :: KafkaLogLevel -> KafkaLogLevel -> Bool
Eq)

-- | All possible Kafka errors
data KafkaError =
    KafkaError Text
  | KafkaInvalidReturnValue
  | KafkaBadSpecification Text
  | KafkaResponseError RdKafkaRespErrT
  | KafkaInvalidConfigurationValue Text
  | KafkaUnknownConfigurationKey Text
  | KafkaBadConfiguration
    deriving (KafkaError -> KafkaError -> Bool
(KafkaError -> KafkaError -> Bool)
-> (KafkaError -> KafkaError -> Bool) -> Eq KafkaError
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: KafkaError -> KafkaError -> Bool
$c/= :: KafkaError -> KafkaError -> Bool
== :: KafkaError -> KafkaError -> Bool
$c== :: KafkaError -> KafkaError -> Bool
Eq, Int -> KafkaError -> ShowS
[KafkaError] -> ShowS
KafkaError -> String
(Int -> KafkaError -> ShowS)
-> (KafkaError -> String)
-> ([KafkaError] -> ShowS)
-> Show KafkaError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [KafkaError] -> ShowS
$cshowList :: [KafkaError] -> ShowS
show :: KafkaError -> String
$cshow :: KafkaError -> String
showsPrec :: Int -> KafkaError -> ShowS
$cshowsPrec :: Int -> KafkaError -> ShowS
Show, Typeable, (forall x. KafkaError -> Rep KafkaError x)
-> (forall x. Rep KafkaError x -> KafkaError) -> Generic KafkaError
forall x. Rep KafkaError x -> KafkaError
forall x. KafkaError -> Rep KafkaError x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep KafkaError x -> KafkaError
$cfrom :: forall x. KafkaError -> Rep KafkaError x
Generic)

instance Exception KafkaError where
  displayException :: KafkaError -> String
displayException (KafkaResponseError err :: RdKafkaRespErrT
err) =
    "[" String -> ShowS
forall a. [a] -> [a] -> [a]
++ RdKafkaRespErrT -> String
rdKafkaErr2name RdKafkaRespErrT
err String -> ShowS
forall a. [a] -> [a] -> [a]
++ "] " String -> ShowS
forall a. [a] -> [a] -> [a]
++ RdKafkaRespErrT -> String
rdKafkaErr2str RdKafkaRespErrT
err
  displayException err :: KafkaError
err = KafkaError -> String
forall a. Show a => a -> String
show KafkaError
err

-- | Available /librdkafka/ debug contexts
data KafkaDebug =
    DebugGeneric
  | DebugBroker
  | DebugTopic
  | DebugMetadata
  | DebugQueue
  | DebugMsg
  | DebugProtocol
  | DebugCgrp
  | DebugSecurity
  | DebugFetch
  | DebugFeature
  | DebugAll
  deriving (KafkaDebug -> KafkaDebug -> Bool
(KafkaDebug -> KafkaDebug -> Bool)
-> (KafkaDebug -> KafkaDebug -> Bool) -> Eq KafkaDebug
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: KafkaDebug -> KafkaDebug -> Bool
$c/= :: KafkaDebug -> KafkaDebug -> Bool
== :: KafkaDebug -> KafkaDebug -> Bool
$c== :: KafkaDebug -> KafkaDebug -> Bool
Eq, Int -> KafkaDebug -> ShowS
[KafkaDebug] -> ShowS
KafkaDebug -> String
(Int -> KafkaDebug -> ShowS)
-> (KafkaDebug -> String)
-> ([KafkaDebug] -> ShowS)
-> Show KafkaDebug
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [KafkaDebug] -> ShowS
$cshowList :: [KafkaDebug] -> ShowS
show :: KafkaDebug -> String
$cshow :: KafkaDebug -> String
showsPrec :: Int -> KafkaDebug -> ShowS
$cshowsPrec :: Int -> KafkaDebug -> ShowS
Show, Typeable, (forall x. KafkaDebug -> Rep KafkaDebug x)
-> (forall x. Rep KafkaDebug x -> KafkaDebug) -> Generic KafkaDebug
forall x. Rep KafkaDebug x -> KafkaDebug
forall x. KafkaDebug -> Rep KafkaDebug x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep KafkaDebug x -> KafkaDebug
$cfrom :: forall x. KafkaDebug -> Rep KafkaDebug x
Generic)

-- | Convert a 'KafkaDebug' into its /librdkafka/ string equivalent.
--
-- This is used internally by the library but may be useful to some developers. 
kafkaDebugToText :: KafkaDebug -> Text
kafkaDebugToText :: KafkaDebug -> Text
kafkaDebugToText d :: KafkaDebug
d = case KafkaDebug
d of
  DebugGeneric  -> "generic"
  DebugBroker   -> "broker"
  DebugTopic    -> "topic"
  DebugMetadata -> "metadata"
  DebugQueue    -> "queue"
  DebugMsg      -> "msg"
  DebugProtocol -> "protocol"
  DebugCgrp     -> "cgrp"
  DebugSecurity -> "security"
  DebugFetch    -> "fetch"
  DebugFeature  -> "feature"
  DebugAll      -> "all"

-- | Compression codec used by a topic
--
-- See <https://kafka.apache.org/documentation/#compression.type Kafka documentation on compression codecs>
data KafkaCompressionCodec =
    NoCompression
  | Gzip
  | Snappy
  | Lz4
  deriving (KafkaCompressionCodec -> KafkaCompressionCodec -> Bool
(KafkaCompressionCodec -> KafkaCompressionCodec -> Bool)
-> (KafkaCompressionCodec -> KafkaCompressionCodec -> Bool)
-> Eq KafkaCompressionCodec
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: KafkaCompressionCodec -> KafkaCompressionCodec -> Bool
$c/= :: KafkaCompressionCodec -> KafkaCompressionCodec -> Bool
== :: KafkaCompressionCodec -> KafkaCompressionCodec -> Bool
$c== :: KafkaCompressionCodec -> KafkaCompressionCodec -> Bool
Eq, Int -> KafkaCompressionCodec -> ShowS
[KafkaCompressionCodec] -> ShowS
KafkaCompressionCodec -> String
(Int -> KafkaCompressionCodec -> ShowS)
-> (KafkaCompressionCodec -> String)
-> ([KafkaCompressionCodec] -> ShowS)
-> Show KafkaCompressionCodec
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [KafkaCompressionCodec] -> ShowS
$cshowList :: [KafkaCompressionCodec] -> ShowS
show :: KafkaCompressionCodec -> String
$cshow :: KafkaCompressionCodec -> String
showsPrec :: Int -> KafkaCompressionCodec -> ShowS
$cshowsPrec :: Int -> KafkaCompressionCodec -> ShowS
Show, Typeable, (forall x. KafkaCompressionCodec -> Rep KafkaCompressionCodec x)
-> (forall x. Rep KafkaCompressionCodec x -> KafkaCompressionCodec)
-> Generic KafkaCompressionCodec
forall x. Rep KafkaCompressionCodec x -> KafkaCompressionCodec
forall x. KafkaCompressionCodec -> Rep KafkaCompressionCodec x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep KafkaCompressionCodec x -> KafkaCompressionCodec
$cfrom :: forall x. KafkaCompressionCodec -> Rep KafkaCompressionCodec x
Generic)

-- | Convert a 'KafkaCompressionCodec' into its /librdkafka/ string equivalent.
--
-- This is used internally by the library but may be useful to some developers.
kafkaCompressionCodecToText :: KafkaCompressionCodec -> Text
kafkaCompressionCodecToText :: KafkaCompressionCodec -> Text
kafkaCompressionCodecToText c :: KafkaCompressionCodec
c = case KafkaCompressionCodec
c of
  NoCompression -> "none"
  Gzip          -> "gzip"
  Snappy        -> "snappy"
  Lz4           -> "lz4"