{-# 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.UpdateStorage
-- 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 cluster broker volume size (or) sets cluster storage mode to
-- TIERED.
module Amazonka.Kafka.UpdateStorage
  ( -- * Creating a Request
    UpdateStorage (..),
    newUpdateStorage,

    -- * Request Lenses
    updateStorage_provisionedThroughput,
    updateStorage_storageMode,
    updateStorage_volumeSizeGB,
    updateStorage_clusterArn,
    updateStorage_currentVersion,

    -- * Destructuring the Response
    UpdateStorageResponse (..),
    newUpdateStorageResponse,

    -- * Response Lenses
    updateStorageResponse_clusterArn,
    updateStorageResponse_clusterOperationArn,
    updateStorageResponse_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

-- | Request object for UpdateStorage api. Its used to update the storage
-- attributes for the cluster.
--
-- /See:/ 'newUpdateStorage' smart constructor.
data UpdateStorage = UpdateStorage'
  { -- | EBS volume provisioned throughput information.
    UpdateStorage -> Maybe ProvisionedThroughput
provisionedThroughput :: Prelude.Maybe ProvisionedThroughput,
    -- | Controls storage mode for supported storage tiers.
    UpdateStorage -> Maybe StorageMode
storageMode :: Prelude.Maybe StorageMode,
    -- | size of the EBS volume to update.
    UpdateStorage -> Maybe Int
volumeSizeGB :: Prelude.Maybe Prelude.Int,
    -- | The Amazon Resource Name (ARN) of the cluster to be updated.
    UpdateStorage -> Text
clusterArn :: Prelude.Text,
    -- | The version of cluster to update from. A successful operation will then
    -- generate a new version.
    UpdateStorage -> Text
currentVersion :: Prelude.Text
  }
  deriving (UpdateStorage -> UpdateStorage -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UpdateStorage -> UpdateStorage -> Bool
$c/= :: UpdateStorage -> UpdateStorage -> Bool
== :: UpdateStorage -> UpdateStorage -> Bool
$c== :: UpdateStorage -> UpdateStorage -> Bool
Prelude.Eq, ReadPrec [UpdateStorage]
ReadPrec UpdateStorage
Int -> ReadS UpdateStorage
ReadS [UpdateStorage]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [UpdateStorage]
$creadListPrec :: ReadPrec [UpdateStorage]
readPrec :: ReadPrec UpdateStorage
$creadPrec :: ReadPrec UpdateStorage
readList :: ReadS [UpdateStorage]
$creadList :: ReadS [UpdateStorage]
readsPrec :: Int -> ReadS UpdateStorage
$creadsPrec :: Int -> ReadS UpdateStorage
Prelude.Read, Int -> UpdateStorage -> ShowS
[UpdateStorage] -> ShowS
UpdateStorage -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UpdateStorage] -> ShowS
$cshowList :: [UpdateStorage] -> ShowS
show :: UpdateStorage -> String
$cshow :: UpdateStorage -> String
showsPrec :: Int -> UpdateStorage -> ShowS
$cshowsPrec :: Int -> UpdateStorage -> ShowS
Prelude.Show, forall x. Rep UpdateStorage x -> UpdateStorage
forall x. UpdateStorage -> Rep UpdateStorage x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep UpdateStorage x -> UpdateStorage
$cfrom :: forall x. UpdateStorage -> Rep UpdateStorage x
Prelude.Generic)

-- |
-- Create a value of 'UpdateStorage' 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:
--
-- 'provisionedThroughput', 'updateStorage_provisionedThroughput' - EBS volume provisioned throughput information.
--
-- 'storageMode', 'updateStorage_storageMode' - Controls storage mode for supported storage tiers.
--
-- 'volumeSizeGB', 'updateStorage_volumeSizeGB' - size of the EBS volume to update.
--
-- 'clusterArn', 'updateStorage_clusterArn' - The Amazon Resource Name (ARN) of the cluster to be updated.
--
-- 'currentVersion', 'updateStorage_currentVersion' - The version of cluster to update from. A successful operation will then
-- generate a new version.
newUpdateStorage ::
  -- | 'clusterArn'
  Prelude.Text ->
  -- | 'currentVersion'
  Prelude.Text ->
  UpdateStorage
newUpdateStorage :: Text -> Text -> UpdateStorage
newUpdateStorage Text
pClusterArn_ Text
pCurrentVersion_ =
  UpdateStorage'
    { $sel:provisionedThroughput:UpdateStorage' :: Maybe ProvisionedThroughput
provisionedThroughput =
        forall a. Maybe a
Prelude.Nothing,
      $sel:storageMode:UpdateStorage' :: Maybe StorageMode
storageMode = forall a. Maybe a
Prelude.Nothing,
      $sel:volumeSizeGB:UpdateStorage' :: Maybe Int
volumeSizeGB = forall a. Maybe a
Prelude.Nothing,
      $sel:clusterArn:UpdateStorage' :: Text
clusterArn = Text
pClusterArn_,
      $sel:currentVersion:UpdateStorage' :: Text
currentVersion = Text
pCurrentVersion_
    }

-- | EBS volume provisioned throughput information.
updateStorage_provisionedThroughput :: Lens.Lens' UpdateStorage (Prelude.Maybe ProvisionedThroughput)
updateStorage_provisionedThroughput :: Lens' UpdateStorage (Maybe ProvisionedThroughput)
updateStorage_provisionedThroughput = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateStorage' {Maybe ProvisionedThroughput
provisionedThroughput :: Maybe ProvisionedThroughput
$sel:provisionedThroughput:UpdateStorage' :: UpdateStorage -> Maybe ProvisionedThroughput
provisionedThroughput} -> Maybe ProvisionedThroughput
provisionedThroughput) (\s :: UpdateStorage
s@UpdateStorage' {} Maybe ProvisionedThroughput
a -> UpdateStorage
s {$sel:provisionedThroughput:UpdateStorage' :: Maybe ProvisionedThroughput
provisionedThroughput = Maybe ProvisionedThroughput
a} :: UpdateStorage)

-- | Controls storage mode for supported storage tiers.
updateStorage_storageMode :: Lens.Lens' UpdateStorage (Prelude.Maybe StorageMode)
updateStorage_storageMode :: Lens' UpdateStorage (Maybe StorageMode)
updateStorage_storageMode = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateStorage' {Maybe StorageMode
storageMode :: Maybe StorageMode
$sel:storageMode:UpdateStorage' :: UpdateStorage -> Maybe StorageMode
storageMode} -> Maybe StorageMode
storageMode) (\s :: UpdateStorage
s@UpdateStorage' {} Maybe StorageMode
a -> UpdateStorage
s {$sel:storageMode:UpdateStorage' :: Maybe StorageMode
storageMode = Maybe StorageMode
a} :: UpdateStorage)

-- | size of the EBS volume to update.
updateStorage_volumeSizeGB :: Lens.Lens' UpdateStorage (Prelude.Maybe Prelude.Int)
updateStorage_volumeSizeGB :: Lens' UpdateStorage (Maybe Int)
updateStorage_volumeSizeGB = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateStorage' {Maybe Int
volumeSizeGB :: Maybe Int
$sel:volumeSizeGB:UpdateStorage' :: UpdateStorage -> Maybe Int
volumeSizeGB} -> Maybe Int
volumeSizeGB) (\s :: UpdateStorage
s@UpdateStorage' {} Maybe Int
a -> UpdateStorage
s {$sel:volumeSizeGB:UpdateStorage' :: Maybe Int
volumeSizeGB = Maybe Int
a} :: UpdateStorage)

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

-- | The version of cluster to update from. A successful operation will then
-- generate a new version.
updateStorage_currentVersion :: Lens.Lens' UpdateStorage Prelude.Text
updateStorage_currentVersion :: Lens' UpdateStorage Text
updateStorage_currentVersion = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateStorage' {Text
currentVersion :: Text
$sel:currentVersion:UpdateStorage' :: UpdateStorage -> Text
currentVersion} -> Text
currentVersion) (\s :: UpdateStorage
s@UpdateStorage' {} Text
a -> UpdateStorage
s {$sel:currentVersion:UpdateStorage' :: Text
currentVersion = Text
a} :: UpdateStorage)

instance Core.AWSRequest UpdateStorage where
  type
    AWSResponse UpdateStorage =
      UpdateStorageResponse
  request :: (Service -> Service) -> UpdateStorage -> Request UpdateStorage
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 UpdateStorage
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse UpdateStorage)))
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 -> UpdateStorageResponse
UpdateStorageResponse'
            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 UpdateStorage where
  hashWithSalt :: Int -> UpdateStorage -> Int
hashWithSalt Int
_salt UpdateStorage' {Maybe Int
Maybe ProvisionedThroughput
Maybe StorageMode
Text
currentVersion :: Text
clusterArn :: Text
volumeSizeGB :: Maybe Int
storageMode :: Maybe StorageMode
provisionedThroughput :: Maybe ProvisionedThroughput
$sel:currentVersion:UpdateStorage' :: UpdateStorage -> Text
$sel:clusterArn:UpdateStorage' :: UpdateStorage -> Text
$sel:volumeSizeGB:UpdateStorage' :: UpdateStorage -> Maybe Int
$sel:storageMode:UpdateStorage' :: UpdateStorage -> Maybe StorageMode
$sel:provisionedThroughput:UpdateStorage' :: UpdateStorage -> Maybe ProvisionedThroughput
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe ProvisionedThroughput
provisionedThroughput
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe StorageMode
storageMode
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Int
volumeSizeGB
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
clusterArn
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
currentVersion

instance Prelude.NFData UpdateStorage where
  rnf :: UpdateStorage -> ()
rnf UpdateStorage' {Maybe Int
Maybe ProvisionedThroughput
Maybe StorageMode
Text
currentVersion :: Text
clusterArn :: Text
volumeSizeGB :: Maybe Int
storageMode :: Maybe StorageMode
provisionedThroughput :: Maybe ProvisionedThroughput
$sel:currentVersion:UpdateStorage' :: UpdateStorage -> Text
$sel:clusterArn:UpdateStorage' :: UpdateStorage -> Text
$sel:volumeSizeGB:UpdateStorage' :: UpdateStorage -> Maybe Int
$sel:storageMode:UpdateStorage' :: UpdateStorage -> Maybe StorageMode
$sel:provisionedThroughput:UpdateStorage' :: UpdateStorage -> Maybe ProvisionedThroughput
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe ProvisionedThroughput
provisionedThroughput
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe StorageMode
storageMode
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Int
volumeSizeGB
      seq :: forall a b. a -> b -> b
`Prelude.seq` 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

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

instance Data.ToPath UpdateStorage where
  toPath :: UpdateStorage -> ByteString
toPath UpdateStorage' {Maybe Int
Maybe ProvisionedThroughput
Maybe StorageMode
Text
currentVersion :: Text
clusterArn :: Text
volumeSizeGB :: Maybe Int
storageMode :: Maybe StorageMode
provisionedThroughput :: Maybe ProvisionedThroughput
$sel:currentVersion:UpdateStorage' :: UpdateStorage -> Text
$sel:clusterArn:UpdateStorage' :: UpdateStorage -> Text
$sel:volumeSizeGB:UpdateStorage' :: UpdateStorage -> Maybe Int
$sel:storageMode:UpdateStorage' :: UpdateStorage -> Maybe StorageMode
$sel:provisionedThroughput:UpdateStorage' :: UpdateStorage -> Maybe ProvisionedThroughput
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ByteString
"/v1/clusters/", forall a. ToByteString a => a -> ByteString
Data.toBS Text
clusterArn, ByteString
"/storage"]

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

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

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

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

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

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

instance Prelude.NFData UpdateStorageResponse where
  rnf :: UpdateStorageResponse -> ()
rnf UpdateStorageResponse' {Int
Maybe Text
httpStatus :: Int
clusterOperationArn :: Maybe Text
clusterArn :: Maybe Text
$sel:httpStatus:UpdateStorageResponse' :: UpdateStorageResponse -> Int
$sel:clusterOperationArn:UpdateStorageResponse' :: UpdateStorageResponse -> Maybe Text
$sel:clusterArn:UpdateStorageResponse' :: UpdateStorageResponse -> 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