{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE StrictData #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# OPTIONS_GHC -fno-warn-unused-imports #-}
{-# OPTIONS_GHC -fno-warn-unused-matches #-}

-- Derived from AWS service descriptions, licensed under Apache 2.0.

-- |
-- Module      : Amazonka.Kafka.Types.BrokerLogs
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
module Amazonka.Kafka.Types.BrokerLogs where

import qualified Amazonka.Core as Core
import qualified Amazonka.Core.Lens.Internal as Lens
import qualified Amazonka.Data as Data
import Amazonka.Kafka.Types.CloudWatchLogs
import Amazonka.Kafka.Types.Firehose
import Amazonka.Kafka.Types.S3
import qualified Amazonka.Prelude as Prelude

-- | /See:/ 'newBrokerLogs' smart constructor.
data BrokerLogs = BrokerLogs'
  { BrokerLogs -> Maybe CloudWatchLogs
cloudWatchLogs :: Prelude.Maybe CloudWatchLogs,
    BrokerLogs -> Maybe Firehose
firehose :: Prelude.Maybe Firehose,
    BrokerLogs -> Maybe S3
s3 :: Prelude.Maybe S3
  }
  deriving (BrokerLogs -> BrokerLogs -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: BrokerLogs -> BrokerLogs -> Bool
$c/= :: BrokerLogs -> BrokerLogs -> Bool
== :: BrokerLogs -> BrokerLogs -> Bool
$c== :: BrokerLogs -> BrokerLogs -> Bool
Prelude.Eq, ReadPrec [BrokerLogs]
ReadPrec BrokerLogs
Int -> ReadS BrokerLogs
ReadS [BrokerLogs]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [BrokerLogs]
$creadListPrec :: ReadPrec [BrokerLogs]
readPrec :: ReadPrec BrokerLogs
$creadPrec :: ReadPrec BrokerLogs
readList :: ReadS [BrokerLogs]
$creadList :: ReadS [BrokerLogs]
readsPrec :: Int -> ReadS BrokerLogs
$creadsPrec :: Int -> ReadS BrokerLogs
Prelude.Read, Int -> BrokerLogs -> ShowS
[BrokerLogs] -> ShowS
BrokerLogs -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [BrokerLogs] -> ShowS
$cshowList :: [BrokerLogs] -> ShowS
show :: BrokerLogs -> String
$cshow :: BrokerLogs -> String
showsPrec :: Int -> BrokerLogs -> ShowS
$cshowsPrec :: Int -> BrokerLogs -> ShowS
Prelude.Show, forall x. Rep BrokerLogs x -> BrokerLogs
forall x. BrokerLogs -> Rep BrokerLogs x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep BrokerLogs x -> BrokerLogs
$cfrom :: forall x. BrokerLogs -> Rep BrokerLogs x
Prelude.Generic)

-- |
-- Create a value of 'BrokerLogs' with all optional fields omitted.
--
-- Use <https://hackage.haskell.org/package/generic-lens generic-lens> or <https://hackage.haskell.org/package/optics optics> to modify other optional fields.
--
-- The following record fields are available, with the corresponding lenses provided
-- for backwards compatibility:
--
-- 'cloudWatchLogs', 'brokerLogs_cloudWatchLogs' - Undocumented member.
--
-- 'firehose', 'brokerLogs_firehose' - Undocumented member.
--
-- 's3', 'brokerLogs_s3' - Undocumented member.
newBrokerLogs ::
  BrokerLogs
newBrokerLogs :: BrokerLogs
newBrokerLogs =
  BrokerLogs'
    { $sel:cloudWatchLogs:BrokerLogs' :: Maybe CloudWatchLogs
cloudWatchLogs = forall a. Maybe a
Prelude.Nothing,
      $sel:firehose:BrokerLogs' :: Maybe Firehose
firehose = forall a. Maybe a
Prelude.Nothing,
      $sel:s3:BrokerLogs' :: Maybe S3
s3 = forall a. Maybe a
Prelude.Nothing
    }

-- | Undocumented member.
brokerLogs_cloudWatchLogs :: Lens.Lens' BrokerLogs (Prelude.Maybe CloudWatchLogs)
brokerLogs_cloudWatchLogs :: Lens' BrokerLogs (Maybe CloudWatchLogs)
brokerLogs_cloudWatchLogs = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\BrokerLogs' {Maybe CloudWatchLogs
cloudWatchLogs :: Maybe CloudWatchLogs
$sel:cloudWatchLogs:BrokerLogs' :: BrokerLogs -> Maybe CloudWatchLogs
cloudWatchLogs} -> Maybe CloudWatchLogs
cloudWatchLogs) (\s :: BrokerLogs
s@BrokerLogs' {} Maybe CloudWatchLogs
a -> BrokerLogs
s {$sel:cloudWatchLogs:BrokerLogs' :: Maybe CloudWatchLogs
cloudWatchLogs = Maybe CloudWatchLogs
a} :: BrokerLogs)

-- | Undocumented member.
brokerLogs_firehose :: Lens.Lens' BrokerLogs (Prelude.Maybe Firehose)
brokerLogs_firehose :: Lens' BrokerLogs (Maybe Firehose)
brokerLogs_firehose = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\BrokerLogs' {Maybe Firehose
firehose :: Maybe Firehose
$sel:firehose:BrokerLogs' :: BrokerLogs -> Maybe Firehose
firehose} -> Maybe Firehose
firehose) (\s :: BrokerLogs
s@BrokerLogs' {} Maybe Firehose
a -> BrokerLogs
s {$sel:firehose:BrokerLogs' :: Maybe Firehose
firehose = Maybe Firehose
a} :: BrokerLogs)

-- | Undocumented member.
brokerLogs_s3 :: Lens.Lens' BrokerLogs (Prelude.Maybe S3)
brokerLogs_s3 :: Lens' BrokerLogs (Maybe S3)
brokerLogs_s3 = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\BrokerLogs' {Maybe S3
s3 :: Maybe S3
$sel:s3:BrokerLogs' :: BrokerLogs -> Maybe S3
s3} -> Maybe S3
s3) (\s :: BrokerLogs
s@BrokerLogs' {} Maybe S3
a -> BrokerLogs
s {$sel:s3:BrokerLogs' :: Maybe S3
s3 = Maybe S3
a} :: BrokerLogs)

instance Data.FromJSON BrokerLogs where
  parseJSON :: Value -> Parser BrokerLogs
parseJSON =
    forall a. String -> (Object -> Parser a) -> Value -> Parser a
Data.withObject
      String
"BrokerLogs"
      ( \Object
x ->
          Maybe CloudWatchLogs -> Maybe Firehose -> Maybe S3 -> BrokerLogs
BrokerLogs'
            forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> (Object
x forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data..:? Key
"cloudWatchLogs")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data..:? Key
"firehose")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data..:? Key
"s3")
      )

instance Prelude.Hashable BrokerLogs where
  hashWithSalt :: Int -> BrokerLogs -> Int
hashWithSalt Int
_salt BrokerLogs' {Maybe CloudWatchLogs
Maybe Firehose
Maybe S3
s3 :: Maybe S3
firehose :: Maybe Firehose
cloudWatchLogs :: Maybe CloudWatchLogs
$sel:s3:BrokerLogs' :: BrokerLogs -> Maybe S3
$sel:firehose:BrokerLogs' :: BrokerLogs -> Maybe Firehose
$sel:cloudWatchLogs:BrokerLogs' :: BrokerLogs -> Maybe CloudWatchLogs
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe CloudWatchLogs
cloudWatchLogs
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Firehose
firehose
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe S3
s3

instance Prelude.NFData BrokerLogs where
  rnf :: BrokerLogs -> ()
rnf BrokerLogs' {Maybe CloudWatchLogs
Maybe Firehose
Maybe S3
s3 :: Maybe S3
firehose :: Maybe Firehose
cloudWatchLogs :: Maybe CloudWatchLogs
$sel:s3:BrokerLogs' :: BrokerLogs -> Maybe S3
$sel:firehose:BrokerLogs' :: BrokerLogs -> Maybe Firehose
$sel:cloudWatchLogs:BrokerLogs' :: BrokerLogs -> Maybe CloudWatchLogs
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe CloudWatchLogs
cloudWatchLogs
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Firehose
firehose
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe S3
s3

instance Data.ToJSON BrokerLogs where
  toJSON :: BrokerLogs -> Value
toJSON BrokerLogs' {Maybe CloudWatchLogs
Maybe Firehose
Maybe S3
s3 :: Maybe S3
firehose :: Maybe Firehose
cloudWatchLogs :: Maybe CloudWatchLogs
$sel:s3:BrokerLogs' :: BrokerLogs -> Maybe S3
$sel:firehose:BrokerLogs' :: BrokerLogs -> Maybe Firehose
$sel:cloudWatchLogs:BrokerLogs' :: BrokerLogs -> Maybe CloudWatchLogs
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"cloudWatchLogs" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=)
              forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe CloudWatchLogs
cloudWatchLogs,
            (Key
"firehose" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe Firehose
firehose,
            (Key
"s3" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe S3
s3
          ]
      )