{-# 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.ClientAuthentication
-- 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.ClientAuthentication 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.Sasl
import Amazonka.Kafka.Types.Tls
import Amazonka.Kafka.Types.Unauthenticated
import qualified Amazonka.Prelude as Prelude

-- | Includes all client authentication information.
--
-- /See:/ 'newClientAuthentication' smart constructor.
data ClientAuthentication = ClientAuthentication'
  { -- | Details for ClientAuthentication using SASL.
    ClientAuthentication -> Maybe Sasl
sasl :: Prelude.Maybe Sasl,
    -- | Details for ClientAuthentication using TLS.
    ClientAuthentication -> Maybe Tls
tls :: Prelude.Maybe Tls,
    -- | Contains information about unauthenticated traffic to the cluster.
    ClientAuthentication -> Maybe Unauthenticated
unauthenticated :: Prelude.Maybe Unauthenticated
  }
  deriving (ClientAuthentication -> ClientAuthentication -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ClientAuthentication -> ClientAuthentication -> Bool
$c/= :: ClientAuthentication -> ClientAuthentication -> Bool
== :: ClientAuthentication -> ClientAuthentication -> Bool
$c== :: ClientAuthentication -> ClientAuthentication -> Bool
Prelude.Eq, ReadPrec [ClientAuthentication]
ReadPrec ClientAuthentication
Int -> ReadS ClientAuthentication
ReadS [ClientAuthentication]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ClientAuthentication]
$creadListPrec :: ReadPrec [ClientAuthentication]
readPrec :: ReadPrec ClientAuthentication
$creadPrec :: ReadPrec ClientAuthentication
readList :: ReadS [ClientAuthentication]
$creadList :: ReadS [ClientAuthentication]
readsPrec :: Int -> ReadS ClientAuthentication
$creadsPrec :: Int -> ReadS ClientAuthentication
Prelude.Read, Int -> ClientAuthentication -> ShowS
[ClientAuthentication] -> ShowS
ClientAuthentication -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ClientAuthentication] -> ShowS
$cshowList :: [ClientAuthentication] -> ShowS
show :: ClientAuthentication -> String
$cshow :: ClientAuthentication -> String
showsPrec :: Int -> ClientAuthentication -> ShowS
$cshowsPrec :: Int -> ClientAuthentication -> ShowS
Prelude.Show, forall x. Rep ClientAuthentication x -> ClientAuthentication
forall x. ClientAuthentication -> Rep ClientAuthentication x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ClientAuthentication x -> ClientAuthentication
$cfrom :: forall x. ClientAuthentication -> Rep ClientAuthentication x
Prelude.Generic)

-- |
-- Create a value of 'ClientAuthentication' 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:
--
-- 'sasl', 'clientAuthentication_sasl' - Details for ClientAuthentication using SASL.
--
-- 'tls', 'clientAuthentication_tls' - Details for ClientAuthentication using TLS.
--
-- 'unauthenticated', 'clientAuthentication_unauthenticated' - Contains information about unauthenticated traffic to the cluster.
newClientAuthentication ::
  ClientAuthentication
newClientAuthentication :: ClientAuthentication
newClientAuthentication =
  ClientAuthentication'
    { $sel:sasl:ClientAuthentication' :: Maybe Sasl
sasl = forall a. Maybe a
Prelude.Nothing,
      $sel:tls:ClientAuthentication' :: Maybe Tls
tls = forall a. Maybe a
Prelude.Nothing,
      $sel:unauthenticated:ClientAuthentication' :: Maybe Unauthenticated
unauthenticated = forall a. Maybe a
Prelude.Nothing
    }

-- | Details for ClientAuthentication using SASL.
clientAuthentication_sasl :: Lens.Lens' ClientAuthentication (Prelude.Maybe Sasl)
clientAuthentication_sasl :: Lens' ClientAuthentication (Maybe Sasl)
clientAuthentication_sasl = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ClientAuthentication' {Maybe Sasl
sasl :: Maybe Sasl
$sel:sasl:ClientAuthentication' :: ClientAuthentication -> Maybe Sasl
sasl} -> Maybe Sasl
sasl) (\s :: ClientAuthentication
s@ClientAuthentication' {} Maybe Sasl
a -> ClientAuthentication
s {$sel:sasl:ClientAuthentication' :: Maybe Sasl
sasl = Maybe Sasl
a} :: ClientAuthentication)

-- | Details for ClientAuthentication using TLS.
clientAuthentication_tls :: Lens.Lens' ClientAuthentication (Prelude.Maybe Tls)
clientAuthentication_tls :: Lens' ClientAuthentication (Maybe Tls)
clientAuthentication_tls = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ClientAuthentication' {Maybe Tls
tls :: Maybe Tls
$sel:tls:ClientAuthentication' :: ClientAuthentication -> Maybe Tls
tls} -> Maybe Tls
tls) (\s :: ClientAuthentication
s@ClientAuthentication' {} Maybe Tls
a -> ClientAuthentication
s {$sel:tls:ClientAuthentication' :: Maybe Tls
tls = Maybe Tls
a} :: ClientAuthentication)

-- | Contains information about unauthenticated traffic to the cluster.
clientAuthentication_unauthenticated :: Lens.Lens' ClientAuthentication (Prelude.Maybe Unauthenticated)
clientAuthentication_unauthenticated :: Lens' ClientAuthentication (Maybe Unauthenticated)
clientAuthentication_unauthenticated = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ClientAuthentication' {Maybe Unauthenticated
unauthenticated :: Maybe Unauthenticated
$sel:unauthenticated:ClientAuthentication' :: ClientAuthentication -> Maybe Unauthenticated
unauthenticated} -> Maybe Unauthenticated
unauthenticated) (\s :: ClientAuthentication
s@ClientAuthentication' {} Maybe Unauthenticated
a -> ClientAuthentication
s {$sel:unauthenticated:ClientAuthentication' :: Maybe Unauthenticated
unauthenticated = Maybe Unauthenticated
a} :: ClientAuthentication)

instance Data.FromJSON ClientAuthentication where
  parseJSON :: Value -> Parser ClientAuthentication
parseJSON =
    forall a. String -> (Object -> Parser a) -> Value -> Parser a
Data.withObject
      String
"ClientAuthentication"
      ( \Object
x ->
          Maybe Sasl
-> Maybe Tls -> Maybe Unauthenticated -> ClientAuthentication
ClientAuthentication'
            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
"sasl")
            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
"tls")
            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
"unauthenticated")
      )

instance Prelude.Hashable ClientAuthentication where
  hashWithSalt :: Int -> ClientAuthentication -> Int
hashWithSalt Int
_salt ClientAuthentication' {Maybe Sasl
Maybe Tls
Maybe Unauthenticated
unauthenticated :: Maybe Unauthenticated
tls :: Maybe Tls
sasl :: Maybe Sasl
$sel:unauthenticated:ClientAuthentication' :: ClientAuthentication -> Maybe Unauthenticated
$sel:tls:ClientAuthentication' :: ClientAuthentication -> Maybe Tls
$sel:sasl:ClientAuthentication' :: ClientAuthentication -> Maybe Sasl
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Sasl
sasl
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Tls
tls
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Unauthenticated
unauthenticated

instance Prelude.NFData ClientAuthentication where
  rnf :: ClientAuthentication -> ()
rnf ClientAuthentication' {Maybe Sasl
Maybe Tls
Maybe Unauthenticated
unauthenticated :: Maybe Unauthenticated
tls :: Maybe Tls
sasl :: Maybe Sasl
$sel:unauthenticated:ClientAuthentication' :: ClientAuthentication -> Maybe Unauthenticated
$sel:tls:ClientAuthentication' :: ClientAuthentication -> Maybe Tls
$sel:sasl:ClientAuthentication' :: ClientAuthentication -> Maybe Sasl
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Sasl
sasl
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Tls
tls
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Unauthenticated
unauthenticated

instance Data.ToJSON ClientAuthentication where
  toJSON :: ClientAuthentication -> Value
toJSON ClientAuthentication' {Maybe Sasl
Maybe Tls
Maybe Unauthenticated
unauthenticated :: Maybe Unauthenticated
tls :: Maybe Tls
sasl :: Maybe Sasl
$sel:unauthenticated:ClientAuthentication' :: ClientAuthentication -> Maybe Unauthenticated
$sel:tls:ClientAuthentication' :: ClientAuthentication -> Maybe Tls
$sel:sasl:ClientAuthentication' :: ClientAuthentication -> Maybe Sasl
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"sasl" 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 Sasl
sasl,
            (Key
"tls" 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 Tls
tls,
            (Key
"unauthenticated" 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 Unauthenticated
unauthenticated
          ]
      )