{-# 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.UpdateBrokerType
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Updates EC2 instance type.
module Amazonka.Kafka.UpdateBrokerType
  ( -- * Creating a Request
    UpdateBrokerType (..),
    newUpdateBrokerType,

    -- * Request Lenses
    updateBrokerType_clusterArn,
    updateBrokerType_currentVersion,
    updateBrokerType_targetInstanceType,

    -- * Destructuring the Response
    UpdateBrokerTypeResponse (..),
    newUpdateBrokerTypeResponse,

    -- * Response Lenses
    updateBrokerTypeResponse_clusterArn,
    updateBrokerTypeResponse_clusterOperationArn,
    updateBrokerTypeResponse_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

-- | /See:/ 'newUpdateBrokerType' smart constructor.
data UpdateBrokerType = UpdateBrokerType'
  { -- | The Amazon Resource Name (ARN) that uniquely identifies the cluster.
    UpdateBrokerType -> Text
clusterArn :: Prelude.Text,
    -- | The cluster version that you want to change. After this operation
    -- completes successfully, the cluster will have a new version.
    UpdateBrokerType -> Text
currentVersion :: Prelude.Text,
    -- | The Amazon MSK broker type that you want all of the brokers in this
    -- cluster to be.
    UpdateBrokerType -> Text
targetInstanceType :: Prelude.Text
  }
  deriving (UpdateBrokerType -> UpdateBrokerType -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UpdateBrokerType -> UpdateBrokerType -> Bool
$c/= :: UpdateBrokerType -> UpdateBrokerType -> Bool
== :: UpdateBrokerType -> UpdateBrokerType -> Bool
$c== :: UpdateBrokerType -> UpdateBrokerType -> Bool
Prelude.Eq, ReadPrec [UpdateBrokerType]
ReadPrec UpdateBrokerType
Int -> ReadS UpdateBrokerType
ReadS [UpdateBrokerType]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [UpdateBrokerType]
$creadListPrec :: ReadPrec [UpdateBrokerType]
readPrec :: ReadPrec UpdateBrokerType
$creadPrec :: ReadPrec UpdateBrokerType
readList :: ReadS [UpdateBrokerType]
$creadList :: ReadS [UpdateBrokerType]
readsPrec :: Int -> ReadS UpdateBrokerType
$creadsPrec :: Int -> ReadS UpdateBrokerType
Prelude.Read, Int -> UpdateBrokerType -> ShowS
[UpdateBrokerType] -> ShowS
UpdateBrokerType -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UpdateBrokerType] -> ShowS
$cshowList :: [UpdateBrokerType] -> ShowS
show :: UpdateBrokerType -> String
$cshow :: UpdateBrokerType -> String
showsPrec :: Int -> UpdateBrokerType -> ShowS
$cshowsPrec :: Int -> UpdateBrokerType -> ShowS
Prelude.Show, forall x. Rep UpdateBrokerType x -> UpdateBrokerType
forall x. UpdateBrokerType -> Rep UpdateBrokerType x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep UpdateBrokerType x -> UpdateBrokerType
$cfrom :: forall x. UpdateBrokerType -> Rep UpdateBrokerType x
Prelude.Generic)

-- |
-- Create a value of 'UpdateBrokerType' 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', 'updateBrokerType_clusterArn' - The Amazon Resource Name (ARN) that uniquely identifies the cluster.
--
-- 'currentVersion', 'updateBrokerType_currentVersion' - The cluster version that you want to change. After this operation
-- completes successfully, the cluster will have a new version.
--
-- 'targetInstanceType', 'updateBrokerType_targetInstanceType' - The Amazon MSK broker type that you want all of the brokers in this
-- cluster to be.
newUpdateBrokerType ::
  -- | 'clusterArn'
  Prelude.Text ->
  -- | 'currentVersion'
  Prelude.Text ->
  -- | 'targetInstanceType'
  Prelude.Text ->
  UpdateBrokerType
newUpdateBrokerType :: Text -> Text -> Text -> UpdateBrokerType
newUpdateBrokerType
  Text
pClusterArn_
  Text
pCurrentVersion_
  Text
pTargetInstanceType_ =
    UpdateBrokerType'
      { $sel:clusterArn:UpdateBrokerType' :: Text
clusterArn = Text
pClusterArn_,
        $sel:currentVersion:UpdateBrokerType' :: Text
currentVersion = Text
pCurrentVersion_,
        $sel:targetInstanceType:UpdateBrokerType' :: Text
targetInstanceType = Text
pTargetInstanceType_
      }

-- | The Amazon Resource Name (ARN) that uniquely identifies the cluster.
updateBrokerType_clusterArn :: Lens.Lens' UpdateBrokerType Prelude.Text
updateBrokerType_clusterArn :: Lens' UpdateBrokerType Text
updateBrokerType_clusterArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateBrokerType' {Text
clusterArn :: Text
$sel:clusterArn:UpdateBrokerType' :: UpdateBrokerType -> Text
clusterArn} -> Text
clusterArn) (\s :: UpdateBrokerType
s@UpdateBrokerType' {} Text
a -> UpdateBrokerType
s {$sel:clusterArn:UpdateBrokerType' :: Text
clusterArn = Text
a} :: UpdateBrokerType)

-- | The cluster version that you want to change. After this operation
-- completes successfully, the cluster will have a new version.
updateBrokerType_currentVersion :: Lens.Lens' UpdateBrokerType Prelude.Text
updateBrokerType_currentVersion :: Lens' UpdateBrokerType Text
updateBrokerType_currentVersion = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateBrokerType' {Text
currentVersion :: Text
$sel:currentVersion:UpdateBrokerType' :: UpdateBrokerType -> Text
currentVersion} -> Text
currentVersion) (\s :: UpdateBrokerType
s@UpdateBrokerType' {} Text
a -> UpdateBrokerType
s {$sel:currentVersion:UpdateBrokerType' :: Text
currentVersion = Text
a} :: UpdateBrokerType)

-- | The Amazon MSK broker type that you want all of the brokers in this
-- cluster to be.
updateBrokerType_targetInstanceType :: Lens.Lens' UpdateBrokerType Prelude.Text
updateBrokerType_targetInstanceType :: Lens' UpdateBrokerType Text
updateBrokerType_targetInstanceType = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateBrokerType' {Text
targetInstanceType :: Text
$sel:targetInstanceType:UpdateBrokerType' :: UpdateBrokerType -> Text
targetInstanceType} -> Text
targetInstanceType) (\s :: UpdateBrokerType
s@UpdateBrokerType' {} Text
a -> UpdateBrokerType
s {$sel:targetInstanceType:UpdateBrokerType' :: Text
targetInstanceType = Text
a} :: UpdateBrokerType)

instance Core.AWSRequest UpdateBrokerType where
  type
    AWSResponse UpdateBrokerType =
      UpdateBrokerTypeResponse
  request :: (Service -> Service)
-> UpdateBrokerType -> Request UpdateBrokerType
request Service -> Service
overrides =
    forall a. (ToRequest a, ToJSON a) => Service -> a -> Request a
Request.putJSON (Service -> Service
overrides Service
defaultService)
  response :: forall (m :: * -> *).
MonadResource m =>
(ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy UpdateBrokerType
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse UpdateBrokerType)))
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 Text -> Int -> UpdateBrokerTypeResponse
UpdateBrokerTypeResponse'
            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
"clusterOperationArn")
            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 UpdateBrokerType where
  hashWithSalt :: Int -> UpdateBrokerType -> Int
hashWithSalt Int
_salt UpdateBrokerType' {Text
targetInstanceType :: Text
currentVersion :: Text
clusterArn :: Text
$sel:targetInstanceType:UpdateBrokerType' :: UpdateBrokerType -> Text
$sel:currentVersion:UpdateBrokerType' :: UpdateBrokerType -> Text
$sel:clusterArn:UpdateBrokerType' :: UpdateBrokerType -> Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
clusterArn
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
currentVersion
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
targetInstanceType

instance Prelude.NFData UpdateBrokerType where
  rnf :: UpdateBrokerType -> ()
rnf UpdateBrokerType' {Text
targetInstanceType :: Text
currentVersion :: Text
clusterArn :: Text
$sel:targetInstanceType:UpdateBrokerType' :: UpdateBrokerType -> Text
$sel:currentVersion:UpdateBrokerType' :: UpdateBrokerType -> Text
$sel:clusterArn:UpdateBrokerType' :: UpdateBrokerType -> 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
currentVersion
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
targetInstanceType

instance Data.ToHeaders UpdateBrokerType where
  toHeaders :: UpdateBrokerType -> 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 UpdateBrokerType where
  toJSON :: UpdateBrokerType -> Value
toJSON UpdateBrokerType' {Text
targetInstanceType :: Text
currentVersion :: Text
clusterArn :: Text
$sel:targetInstanceType:UpdateBrokerType' :: UpdateBrokerType -> Text
$sel:currentVersion:UpdateBrokerType' :: UpdateBrokerType -> Text
$sel:clusterArn:UpdateBrokerType' :: UpdateBrokerType -> Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ forall a. a -> Maybe a
Prelude.Just
              (Key
"currentVersion" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
currentVersion),
            forall a. a -> Maybe a
Prelude.Just
              (Key
"targetInstanceType" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
targetInstanceType)
          ]
      )

instance Data.ToPath UpdateBrokerType where
  toPath :: UpdateBrokerType -> ByteString
toPath UpdateBrokerType' {Text
targetInstanceType :: Text
currentVersion :: Text
clusterArn :: Text
$sel:targetInstanceType:UpdateBrokerType' :: UpdateBrokerType -> Text
$sel:currentVersion:UpdateBrokerType' :: UpdateBrokerType -> Text
$sel:clusterArn:UpdateBrokerType' :: UpdateBrokerType -> Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"/v1/clusters/",
        forall a. ToByteString a => a -> ByteString
Data.toBS Text
clusterArn,
        ByteString
"/nodes/type"
      ]

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

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

-- |
-- Create a value of 'UpdateBrokerTypeResponse' 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', 'updateBrokerTypeResponse_clusterArn' - The Amazon Resource Name (ARN) of the cluster.
--
-- 'clusterOperationArn', 'updateBrokerTypeResponse_clusterOperationArn' - The Amazon Resource Name (ARN) of the cluster operation.
--
-- 'httpStatus', 'updateBrokerTypeResponse_httpStatus' - The response's http status code.
newUpdateBrokerTypeResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  UpdateBrokerTypeResponse
newUpdateBrokerTypeResponse :: Int -> UpdateBrokerTypeResponse
newUpdateBrokerTypeResponse Int
pHttpStatus_ =
  UpdateBrokerTypeResponse'
    { $sel:clusterArn:UpdateBrokerTypeResponse' :: Maybe Text
clusterArn =
        forall a. Maybe a
Prelude.Nothing,
      $sel:clusterOperationArn:UpdateBrokerTypeResponse' :: Maybe Text
clusterOperationArn = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:UpdateBrokerTypeResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

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

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

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

instance Prelude.NFData UpdateBrokerTypeResponse where
  rnf :: UpdateBrokerTypeResponse -> ()
rnf UpdateBrokerTypeResponse' {Int
Maybe Text
httpStatus :: Int
clusterOperationArn :: Maybe Text
clusterArn :: Maybe Text
$sel:httpStatus:UpdateBrokerTypeResponse' :: UpdateBrokerTypeResponse -> Int
$sel:clusterOperationArn:UpdateBrokerTypeResponse' :: UpdateBrokerTypeResponse -> Maybe Text
$sel:clusterArn:UpdateBrokerTypeResponse' :: UpdateBrokerTypeResponse -> 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 Text
clusterOperationArn
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus