{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE StrictData #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# OPTIONS_GHC -fno-warn-unused-binds #-}
{-# 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.BatchAssociateScramSecret
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Associates one or more Scram Secrets with an Amazon MSK cluster.
module Amazonka.Kafka.BatchAssociateScramSecret
  ( -- * Creating a Request
    BatchAssociateScramSecret (..),
    newBatchAssociateScramSecret,

    -- * Request Lenses
    batchAssociateScramSecret_clusterArn,
    batchAssociateScramSecret_secretArnList,

    -- * Destructuring the Response
    BatchAssociateScramSecretResponse (..),
    newBatchAssociateScramSecretResponse,

    -- * Response Lenses
    batchAssociateScramSecretResponse_clusterArn,
    batchAssociateScramSecretResponse_unprocessedScramSecrets,
    batchAssociateScramSecretResponse_httpStatus,
  )
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
import qualified Amazonka.Prelude as Prelude
import qualified Amazonka.Request as Request
import qualified Amazonka.Response as Response

-- | Associates sasl scram secrets to cluster.
--
-- /See:/ 'newBatchAssociateScramSecret' smart constructor.
data BatchAssociateScramSecret = BatchAssociateScramSecret'
  { -- | The Amazon Resource Name (ARN) of the cluster to be updated.
    BatchAssociateScramSecret -> Text
clusterArn :: Prelude.Text,
    -- | List of AWS Secrets Manager secret ARNs.
    BatchAssociateScramSecret -> [Text]
secretArnList :: [Prelude.Text]
  }
  deriving (BatchAssociateScramSecret -> BatchAssociateScramSecret -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: BatchAssociateScramSecret -> BatchAssociateScramSecret -> Bool
$c/= :: BatchAssociateScramSecret -> BatchAssociateScramSecret -> Bool
== :: BatchAssociateScramSecret -> BatchAssociateScramSecret -> Bool
$c== :: BatchAssociateScramSecret -> BatchAssociateScramSecret -> Bool
Prelude.Eq, ReadPrec [BatchAssociateScramSecret]
ReadPrec BatchAssociateScramSecret
Int -> ReadS BatchAssociateScramSecret
ReadS [BatchAssociateScramSecret]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [BatchAssociateScramSecret]
$creadListPrec :: ReadPrec [BatchAssociateScramSecret]
readPrec :: ReadPrec BatchAssociateScramSecret
$creadPrec :: ReadPrec BatchAssociateScramSecret
readList :: ReadS [BatchAssociateScramSecret]
$creadList :: ReadS [BatchAssociateScramSecret]
readsPrec :: Int -> ReadS BatchAssociateScramSecret
$creadsPrec :: Int -> ReadS BatchAssociateScramSecret
Prelude.Read, Int -> BatchAssociateScramSecret -> ShowS
[BatchAssociateScramSecret] -> ShowS
BatchAssociateScramSecret -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [BatchAssociateScramSecret] -> ShowS
$cshowList :: [BatchAssociateScramSecret] -> ShowS
show :: BatchAssociateScramSecret -> String
$cshow :: BatchAssociateScramSecret -> String
showsPrec :: Int -> BatchAssociateScramSecret -> ShowS
$cshowsPrec :: Int -> BatchAssociateScramSecret -> ShowS
Prelude.Show, forall x.
Rep BatchAssociateScramSecret x -> BatchAssociateScramSecret
forall x.
BatchAssociateScramSecret -> Rep BatchAssociateScramSecret x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep BatchAssociateScramSecret x -> BatchAssociateScramSecret
$cfrom :: forall x.
BatchAssociateScramSecret -> Rep BatchAssociateScramSecret x
Prelude.Generic)

-- |
-- Create a value of 'BatchAssociateScramSecret' 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:
--
-- 'clusterArn', 'batchAssociateScramSecret_clusterArn' - The Amazon Resource Name (ARN) of the cluster to be updated.
--
-- 'secretArnList', 'batchAssociateScramSecret_secretArnList' - List of AWS Secrets Manager secret ARNs.
newBatchAssociateScramSecret ::
  -- | 'clusterArn'
  Prelude.Text ->
  BatchAssociateScramSecret
newBatchAssociateScramSecret :: Text -> BatchAssociateScramSecret
newBatchAssociateScramSecret Text
pClusterArn_ =
  BatchAssociateScramSecret'
    { $sel:clusterArn:BatchAssociateScramSecret' :: Text
clusterArn =
        Text
pClusterArn_,
      $sel:secretArnList:BatchAssociateScramSecret' :: [Text]
secretArnList = forall a. Monoid a => a
Prelude.mempty
    }

-- | The Amazon Resource Name (ARN) of the cluster to be updated.
batchAssociateScramSecret_clusterArn :: Lens.Lens' BatchAssociateScramSecret Prelude.Text
batchAssociateScramSecret_clusterArn :: Lens' BatchAssociateScramSecret Text
batchAssociateScramSecret_clusterArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\BatchAssociateScramSecret' {Text
clusterArn :: Text
$sel:clusterArn:BatchAssociateScramSecret' :: BatchAssociateScramSecret -> Text
clusterArn} -> Text
clusterArn) (\s :: BatchAssociateScramSecret
s@BatchAssociateScramSecret' {} Text
a -> BatchAssociateScramSecret
s {$sel:clusterArn:BatchAssociateScramSecret' :: Text
clusterArn = Text
a} :: BatchAssociateScramSecret)

-- | List of AWS Secrets Manager secret ARNs.
batchAssociateScramSecret_secretArnList :: Lens.Lens' BatchAssociateScramSecret [Prelude.Text]
batchAssociateScramSecret_secretArnList :: Lens' BatchAssociateScramSecret [Text]
batchAssociateScramSecret_secretArnList = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\BatchAssociateScramSecret' {[Text]
secretArnList :: [Text]
$sel:secretArnList:BatchAssociateScramSecret' :: BatchAssociateScramSecret -> [Text]
secretArnList} -> [Text]
secretArnList) (\s :: BatchAssociateScramSecret
s@BatchAssociateScramSecret' {} [Text]
a -> BatchAssociateScramSecret
s {$sel:secretArnList:BatchAssociateScramSecret' :: [Text]
secretArnList = [Text]
a} :: BatchAssociateScramSecret) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Lens.coerced

instance Core.AWSRequest BatchAssociateScramSecret where
  type
    AWSResponse BatchAssociateScramSecret =
      BatchAssociateScramSecretResponse
  request :: (Service -> Service)
-> BatchAssociateScramSecret -> Request BatchAssociateScramSecret
request Service -> Service
overrides =
    forall a. (ToRequest a, ToJSON a) => Service -> a -> Request a
Request.postJSON (Service -> Service
overrides Service
defaultService)
  response :: forall (m :: * -> *).
MonadResource m =>
(ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy BatchAssociateScramSecret
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse BatchAssociateScramSecret)))
response =
    forall (m :: * -> *) a.
MonadResource m =>
(Int -> ResponseHeaders -> Object -> Either String (AWSResponse a))
-> (ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy a
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse a)))
Response.receiveJSON
      ( \Int
s ResponseHeaders
h Object
x ->
          Maybe Text
-> Maybe [UnprocessedScramSecret]
-> Int
-> BatchAssociateScramSecretResponse
BatchAssociateScramSecretResponse'
            forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"clusterArn")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> ( Object
x
                            forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"unprocessedScramSecrets"
                            forall (f :: * -> *) a. Functor f => f (Maybe a) -> a -> f a
Core..!@ forall a. Monoid a => a
Prelude.mempty
                        )
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (forall (f :: * -> *) a. Applicative f => a -> f a
Prelude.pure (forall a. Enum a => a -> Int
Prelude.fromEnum Int
s))
      )

instance Prelude.Hashable BatchAssociateScramSecret where
  hashWithSalt :: Int -> BatchAssociateScramSecret -> Int
hashWithSalt Int
_salt BatchAssociateScramSecret' {[Text]
Text
secretArnList :: [Text]
clusterArn :: Text
$sel:secretArnList:BatchAssociateScramSecret' :: BatchAssociateScramSecret -> [Text]
$sel:clusterArn:BatchAssociateScramSecret' :: BatchAssociateScramSecret -> Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
clusterArn
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` [Text]
secretArnList

instance Prelude.NFData BatchAssociateScramSecret where
  rnf :: BatchAssociateScramSecret -> ()
rnf BatchAssociateScramSecret' {[Text]
Text
secretArnList :: [Text]
clusterArn :: Text
$sel:secretArnList:BatchAssociateScramSecret' :: BatchAssociateScramSecret -> [Text]
$sel:clusterArn:BatchAssociateScramSecret' :: BatchAssociateScramSecret -> Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Text
clusterArn
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf [Text]
secretArnList

instance Data.ToHeaders BatchAssociateScramSecret where
  toHeaders :: BatchAssociateScramSecret -> ResponseHeaders
toHeaders =
    forall a b. a -> b -> a
Prelude.const
      ( forall a. Monoid a => [a] -> a
Prelude.mconcat
          [ HeaderName
"Content-Type"
              forall a. ToHeader a => HeaderName -> a -> ResponseHeaders
Data.=# ( ByteString
"application/x-amz-json-1.1" ::
                          Prelude.ByteString
                      )
          ]
      )

instance Data.ToJSON BatchAssociateScramSecret where
  toJSON :: BatchAssociateScramSecret -> Value
toJSON BatchAssociateScramSecret' {[Text]
Text
secretArnList :: [Text]
clusterArn :: Text
$sel:secretArnList:BatchAssociateScramSecret' :: BatchAssociateScramSecret -> [Text]
$sel:clusterArn:BatchAssociateScramSecret' :: BatchAssociateScramSecret -> Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ forall a. a -> Maybe a
Prelude.Just
              (Key
"secretArnList" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= [Text]
secretArnList)
          ]
      )

instance Data.ToPath BatchAssociateScramSecret where
  toPath :: BatchAssociateScramSecret -> ByteString
toPath BatchAssociateScramSecret' {[Text]
Text
secretArnList :: [Text]
clusterArn :: Text
$sel:secretArnList:BatchAssociateScramSecret' :: BatchAssociateScramSecret -> [Text]
$sel:clusterArn:BatchAssociateScramSecret' :: BatchAssociateScramSecret -> Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"/v1/clusters/",
        forall a. ToByteString a => a -> ByteString
Data.toBS Text
clusterArn,
        ByteString
"/scram-secrets"
      ]

instance Data.ToQuery BatchAssociateScramSecret where
  toQuery :: BatchAssociateScramSecret -> QueryString
toQuery = forall a b. a -> b -> a
Prelude.const forall a. Monoid a => a
Prelude.mempty

-- | /See:/ 'newBatchAssociateScramSecretResponse' smart constructor.
data BatchAssociateScramSecretResponse = BatchAssociateScramSecretResponse'
  { -- | The Amazon Resource Name (ARN) of the cluster.
    BatchAssociateScramSecretResponse -> Maybe Text
clusterArn :: Prelude.Maybe Prelude.Text,
    -- | List of errors when associating secrets to cluster.
    BatchAssociateScramSecretResponse -> Maybe [UnprocessedScramSecret]
unprocessedScramSecrets :: Prelude.Maybe [UnprocessedScramSecret],
    -- | The response's http status code.
    BatchAssociateScramSecretResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (BatchAssociateScramSecretResponse
-> BatchAssociateScramSecretResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: BatchAssociateScramSecretResponse
-> BatchAssociateScramSecretResponse -> Bool
$c/= :: BatchAssociateScramSecretResponse
-> BatchAssociateScramSecretResponse -> Bool
== :: BatchAssociateScramSecretResponse
-> BatchAssociateScramSecretResponse -> Bool
$c== :: BatchAssociateScramSecretResponse
-> BatchAssociateScramSecretResponse -> Bool
Prelude.Eq, ReadPrec [BatchAssociateScramSecretResponse]
ReadPrec BatchAssociateScramSecretResponse
Int -> ReadS BatchAssociateScramSecretResponse
ReadS [BatchAssociateScramSecretResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [BatchAssociateScramSecretResponse]
$creadListPrec :: ReadPrec [BatchAssociateScramSecretResponse]
readPrec :: ReadPrec BatchAssociateScramSecretResponse
$creadPrec :: ReadPrec BatchAssociateScramSecretResponse
readList :: ReadS [BatchAssociateScramSecretResponse]
$creadList :: ReadS [BatchAssociateScramSecretResponse]
readsPrec :: Int -> ReadS BatchAssociateScramSecretResponse
$creadsPrec :: Int -> ReadS BatchAssociateScramSecretResponse
Prelude.Read, Int -> BatchAssociateScramSecretResponse -> ShowS
[BatchAssociateScramSecretResponse] -> ShowS
BatchAssociateScramSecretResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [BatchAssociateScramSecretResponse] -> ShowS
$cshowList :: [BatchAssociateScramSecretResponse] -> ShowS
show :: BatchAssociateScramSecretResponse -> String
$cshow :: BatchAssociateScramSecretResponse -> String
showsPrec :: Int -> BatchAssociateScramSecretResponse -> ShowS
$cshowsPrec :: Int -> BatchAssociateScramSecretResponse -> ShowS
Prelude.Show, forall x.
Rep BatchAssociateScramSecretResponse x
-> BatchAssociateScramSecretResponse
forall x.
BatchAssociateScramSecretResponse
-> Rep BatchAssociateScramSecretResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep BatchAssociateScramSecretResponse x
-> BatchAssociateScramSecretResponse
$cfrom :: forall x.
BatchAssociateScramSecretResponse
-> Rep BatchAssociateScramSecretResponse x
Prelude.Generic)

-- |
-- Create a value of 'BatchAssociateScramSecretResponse' 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:
--
-- 'clusterArn', 'batchAssociateScramSecretResponse_clusterArn' - The Amazon Resource Name (ARN) of the cluster.
--
-- 'unprocessedScramSecrets', 'batchAssociateScramSecretResponse_unprocessedScramSecrets' - List of errors when associating secrets to cluster.
--
-- 'httpStatus', 'batchAssociateScramSecretResponse_httpStatus' - The response's http status code.
newBatchAssociateScramSecretResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  BatchAssociateScramSecretResponse
newBatchAssociateScramSecretResponse :: Int -> BatchAssociateScramSecretResponse
newBatchAssociateScramSecretResponse Int
pHttpStatus_ =
  BatchAssociateScramSecretResponse'
    { $sel:clusterArn:BatchAssociateScramSecretResponse' :: Maybe Text
clusterArn =
        forall a. Maybe a
Prelude.Nothing,
      $sel:unprocessedScramSecrets:BatchAssociateScramSecretResponse' :: Maybe [UnprocessedScramSecret]
unprocessedScramSecrets =
        forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:BatchAssociateScramSecretResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | The Amazon Resource Name (ARN) of the cluster.
batchAssociateScramSecretResponse_clusterArn :: Lens.Lens' BatchAssociateScramSecretResponse (Prelude.Maybe Prelude.Text)
batchAssociateScramSecretResponse_clusterArn :: Lens' BatchAssociateScramSecretResponse (Maybe Text)
batchAssociateScramSecretResponse_clusterArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\BatchAssociateScramSecretResponse' {Maybe Text
clusterArn :: Maybe Text
$sel:clusterArn:BatchAssociateScramSecretResponse' :: BatchAssociateScramSecretResponse -> Maybe Text
clusterArn} -> Maybe Text
clusterArn) (\s :: BatchAssociateScramSecretResponse
s@BatchAssociateScramSecretResponse' {} Maybe Text
a -> BatchAssociateScramSecretResponse
s {$sel:clusterArn:BatchAssociateScramSecretResponse' :: Maybe Text
clusterArn = Maybe Text
a} :: BatchAssociateScramSecretResponse)

-- | List of errors when associating secrets to cluster.
batchAssociateScramSecretResponse_unprocessedScramSecrets :: Lens.Lens' BatchAssociateScramSecretResponse (Prelude.Maybe [UnprocessedScramSecret])
batchAssociateScramSecretResponse_unprocessedScramSecrets :: Lens'
  BatchAssociateScramSecretResponse (Maybe [UnprocessedScramSecret])
batchAssociateScramSecretResponse_unprocessedScramSecrets = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\BatchAssociateScramSecretResponse' {Maybe [UnprocessedScramSecret]
unprocessedScramSecrets :: Maybe [UnprocessedScramSecret]
$sel:unprocessedScramSecrets:BatchAssociateScramSecretResponse' :: BatchAssociateScramSecretResponse -> Maybe [UnprocessedScramSecret]
unprocessedScramSecrets} -> Maybe [UnprocessedScramSecret]
unprocessedScramSecrets) (\s :: BatchAssociateScramSecretResponse
s@BatchAssociateScramSecretResponse' {} Maybe [UnprocessedScramSecret]
a -> BatchAssociateScramSecretResponse
s {$sel:unprocessedScramSecrets:BatchAssociateScramSecretResponse' :: Maybe [UnprocessedScramSecret]
unprocessedScramSecrets = Maybe [UnprocessedScramSecret]
a} :: BatchAssociateScramSecretResponse) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall (f :: * -> *) (g :: * -> *) s t a b.
(Functor f, Functor g) =>
AnIso s t a b -> Iso (f s) (g t) (f a) (g b)
Lens.mapping forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Lens.coerced

-- | The response's http status code.
batchAssociateScramSecretResponse_httpStatus :: Lens.Lens' BatchAssociateScramSecretResponse Prelude.Int
batchAssociateScramSecretResponse_httpStatus :: Lens' BatchAssociateScramSecretResponse Int
batchAssociateScramSecretResponse_httpStatus = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\BatchAssociateScramSecretResponse' {Int
httpStatus :: Int
$sel:httpStatus:BatchAssociateScramSecretResponse' :: BatchAssociateScramSecretResponse -> Int
httpStatus} -> Int
httpStatus) (\s :: BatchAssociateScramSecretResponse
s@BatchAssociateScramSecretResponse' {} Int
a -> BatchAssociateScramSecretResponse
s {$sel:httpStatus:BatchAssociateScramSecretResponse' :: Int
httpStatus = Int
a} :: BatchAssociateScramSecretResponse)

instance
  Prelude.NFData
    BatchAssociateScramSecretResponse
  where
  rnf :: BatchAssociateScramSecretResponse -> ()
rnf BatchAssociateScramSecretResponse' {Int
Maybe [UnprocessedScramSecret]
Maybe Text
httpStatus :: Int
unprocessedScramSecrets :: Maybe [UnprocessedScramSecret]
clusterArn :: Maybe Text
$sel:httpStatus:BatchAssociateScramSecretResponse' :: BatchAssociateScramSecretResponse -> Int
$sel:unprocessedScramSecrets:BatchAssociateScramSecretResponse' :: BatchAssociateScramSecretResponse -> Maybe [UnprocessedScramSecret]
$sel:clusterArn:BatchAssociateScramSecretResponse' :: BatchAssociateScramSecretResponse -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
clusterArn
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [UnprocessedScramSecret]
unprocessedScramSecrets
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus