{-# language BangPatterns #-}
{-# language DuplicateRecordFields #-}
{-# language NamedFieldPuns #-}

module Kafka.FindCoordinator.Response.V4
  ( Response(..)
  , Coordinator(..)
  , parser
  , decode
  , decodeHeaded
  ) where

import Control.Applicative (liftA2)
import Data.Bytes (Bytes)
import Data.Bytes.Parser (Parser)
import Data.Int (Int16)
import Data.Int (Int32)
import Data.Primitive (SmallArray)
import Data.Text (Text)
import Kafka.ErrorCode (ErrorCode)
import Kafka.Parser.Context (Context)
import Kafka.TaggedField (TaggedField)

import qualified Data.Bytes.Parser as Parser
import qualified Kafka.Parser.Context as Ctx
import qualified Kafka.Header.Response.V0 as Header
import qualified Kafka.TaggedField as TaggedField
import qualified Kafka.Parser

data Response = Response
  { Response -> Int32
throttleTimeMilliseconds :: !Int32
  , Response -> SmallArray Coordinator
coordinators :: !(SmallArray Coordinator)
  , Response -> SmallArray TaggedField
taggedFields :: !(SmallArray TaggedField)
  } deriving (Int -> Response -> ShowS
[Response] -> ShowS
Response -> String
(Int -> Response -> ShowS)
-> (Response -> String) -> ([Response] -> ShowS) -> Show Response
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Response -> ShowS
showsPrec :: Int -> Response -> ShowS
$cshow :: Response -> String
show :: Response -> String
$cshowList :: [Response] -> ShowS
showList :: [Response] -> ShowS
Show)

data Coordinator = Coordinator
  { Coordinator -> Text
key :: !Text
  , Coordinator -> Int32
nodeId :: !Int32
  , Coordinator -> Text
host :: !Text
  , Coordinator -> Int32
port :: !Int32
  , Coordinator -> ErrorCode
errorCode :: !ErrorCode
  , Coordinator -> Text
errorMessage :: !Text
  , Coordinator -> SmallArray TaggedField
taggedFields :: !(SmallArray TaggedField)
  } deriving (Int -> Coordinator -> ShowS
[Coordinator] -> ShowS
Coordinator -> String
(Int -> Coordinator -> ShowS)
-> (Coordinator -> String)
-> ([Coordinator] -> ShowS)
-> Show Coordinator
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Coordinator -> ShowS
showsPrec :: Int -> Coordinator -> ShowS
$cshow :: Coordinator -> String
show :: Coordinator -> String
$cshowList :: [Coordinator] -> ShowS
showList :: [Coordinator] -> ShowS
Show)

parserCoordinator :: Context -> Parser Context s Coordinator
parserCoordinator :: forall s. Context -> Parser Context s Coordinator
parserCoordinator Context
ctx = do
  Text
key <- Context -> Parser Context s Text
forall s. Context -> Parser Context s Text
Kafka.Parser.compactString (Field -> Context -> Context
Ctx.Field Field
Ctx.Key Context
ctx)
  Int32
nodeId <- Context -> Parser Context s Int32
forall e s. e -> Parser e s Int32
Kafka.Parser.int32 (Field -> Context -> Context
Ctx.Field Field
Ctx.NodeId Context
ctx)
  Text
host <- Context -> Parser Context s Text
forall s. Context -> Parser Context s Text
Kafka.Parser.compactString (Field -> Context -> Context
Ctx.Field Field
Ctx.Host Context
ctx)
  Int32
port <- Context -> Parser Context s Int32
forall e s. e -> Parser e s Int32
Kafka.Parser.int32 (Field -> Context -> Context
Ctx.Field Field
Ctx.Port Context
ctx)
  ErrorCode
errorCode <- Context -> Parser Context s ErrorCode
forall e s. e -> Parser e s ErrorCode
Kafka.Parser.errorCode (Field -> Context -> Context
Ctx.Field Field
Ctx.ErrorCode Context
ctx)
  Text
errorMessage <- Context -> Parser Context s Text
forall s. Context -> Parser Context s Text
Kafka.Parser.compactString (Field -> Context -> Context
Ctx.Field Field
Ctx.ErrorMessage Context
ctx)
  SmallArray TaggedField
taggedFields <- Context -> Parser Context s (SmallArray TaggedField)
forall s. Context -> Parser Context s (SmallArray TaggedField)
TaggedField.parserMany (Field -> Context -> Context
Ctx.Field Field
Ctx.TagBuffer Context
ctx)
  Coordinator -> Parser Context s Coordinator
forall a. a -> Parser Context s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Coordinator{Text
$sel:key:Coordinator :: Text
key :: Text
key,Int32
$sel:nodeId:Coordinator :: Int32
nodeId :: Int32
nodeId,Text
$sel:host:Coordinator :: Text
host :: Text
host,Int32
$sel:port:Coordinator :: Int32
port :: Int32
port,ErrorCode
$sel:errorCode:Coordinator :: ErrorCode
errorCode :: ErrorCode
errorCode,Text
$sel:errorMessage:Coordinator :: Text
errorMessage :: Text
errorMessage,SmallArray TaggedField
$sel:taggedFields:Coordinator :: SmallArray TaggedField
taggedFields :: SmallArray TaggedField
taggedFields}

parser :: Context -> Parser Context s Response
parser :: forall s. Context -> Parser Context s Response
parser Context
ctx = do
  Int32
throttleTimeMilliseconds <- Context -> Parser Context s Int32
forall e s. e -> Parser e s Int32
Kafka.Parser.int32 (Field -> Context -> Context
Ctx.Field Field
Ctx.ThrottleTimeMilliseconds Context
ctx)
  SmallArray Coordinator
coordinators <- (Context -> Parser Context s Coordinator)
-> Context -> Parser Context s (SmallArray Coordinator)
forall s a.
(Context -> Parser Context s a)
-> Context -> Parser Context s (SmallArray a)
Kafka.Parser.compactArray Context -> Parser Context s Coordinator
forall s. Context -> Parser Context s Coordinator
parserCoordinator (Field -> Context -> Context
Ctx.Field Field
Ctx.Coordinators Context
ctx) 
  SmallArray TaggedField
taggedFields <- Context -> Parser Context s (SmallArray TaggedField)
forall s. Context -> Parser Context s (SmallArray TaggedField)
TaggedField.parserMany (Field -> Context -> Context
Ctx.Field Field
Ctx.TagBuffer Context
ctx)
  Response -> Parser Context s Response
forall a. a -> Parser Context s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Response{Int32
$sel:throttleTimeMilliseconds:Response :: Int32
throttleTimeMilliseconds :: Int32
throttleTimeMilliseconds,SmallArray Coordinator
$sel:coordinators:Response :: SmallArray Coordinator
coordinators :: SmallArray Coordinator
coordinators,SmallArray TaggedField
$sel:taggedFields:Response :: SmallArray TaggedField
taggedFields :: SmallArray TaggedField
taggedFields}

decodeHeaded :: Bytes -> Either Context (Header.Headed Response)
decodeHeaded :: Bytes -> Either Context (Headed Response)
decodeHeaded !Bytes
b = (forall s. Parser Context s (Headed Response))
-> Bytes -> Either Context (Headed Response)
forall e a. (forall s. Parser e s a) -> Bytes -> Either e a
Parser.parseBytesEither
  ((Header -> Response -> Headed Response)
-> Parser Context s Header
-> Parser Context s Response
-> Parser Context s (Headed Response)
forall a b c.
(a -> b -> c)
-> Parser Context s a -> Parser Context s b -> Parser Context s c
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 Header -> Response -> Headed Response
forall a. Header -> a -> Headed a
Header.Headed
    (Context -> Parser Context s Header
forall s. Context -> Parser Context s Header
Header.parser Context
Ctx.Top)
    (Context -> Parser Context s Response
forall s. Context -> Parser Context s Response
parser Context
Ctx.Top Parser Context s Response
-> Parser Context s () -> Parser Context s Response
forall a b.
Parser Context s a -> Parser Context s b -> Parser Context s a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Context -> Parser Context s ()
forall e s. e -> Parser e s ()
Parser.endOfInput Context
Ctx.End)
  ) Bytes
b

decode :: Bytes -> Either Context Response
decode :: Bytes -> Either Context Response
decode !Bytes
b = (forall s. Parser Context s Response)
-> Bytes -> Either Context Response
forall e a. (forall s. Parser e s a) -> Bytes -> Either e a
Parser.parseBytesEither (Context -> Parser Context s Response
forall s. Context -> Parser Context s Response
parser Context
Ctx.Top Parser Context s Response
-> Parser Context s () -> Parser Context s Response
forall a b.
Parser Context s a -> Parser Context s b -> Parser Context s a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Context -> Parser Context s ()
forall e s. e -> Parser e s ()
Parser.endOfInput Context
Ctx.End) Bytes
b