{-# 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.ElastiCache.ListAllowedNodeTypeModifications
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Lists all available node types that you can scale your Redis cluster\'s
-- or replication group\'s current node type.
--
-- When you use the @ModifyCacheCluster@ or @ModifyReplicationGroup@
-- operations to scale your cluster or replication group, the value of the
-- @CacheNodeType@ parameter must be one of the node types returned by this
-- operation.
module Amazonka.ElastiCache.ListAllowedNodeTypeModifications
  ( -- * Creating a Request
    ListAllowedNodeTypeModifications (..),
    newListAllowedNodeTypeModifications,

    -- * Request Lenses
    listAllowedNodeTypeModifications_cacheClusterId,
    listAllowedNodeTypeModifications_replicationGroupId,

    -- * Destructuring the Response
    ListAllowedNodeTypeModificationsResponse (..),
    newListAllowedNodeTypeModificationsResponse,

    -- * Response Lenses
    listAllowedNodeTypeModificationsResponse_scaleDownModifications,
    listAllowedNodeTypeModificationsResponse_scaleUpModifications,
    listAllowedNodeTypeModificationsResponse_httpStatus,
  )
where

import qualified Amazonka.Core as Core
import qualified Amazonka.Core.Lens.Internal as Lens
import qualified Amazonka.Data as Data
import Amazonka.ElastiCache.Types
import qualified Amazonka.Prelude as Prelude
import qualified Amazonka.Request as Request
import qualified Amazonka.Response as Response

-- | The input parameters for the @ListAllowedNodeTypeModifications@
-- operation.
--
-- /See:/ 'newListAllowedNodeTypeModifications' smart constructor.
data ListAllowedNodeTypeModifications = ListAllowedNodeTypeModifications'
  { -- | The name of the cluster you want to scale up to a larger node instanced
    -- type. ElastiCache uses the cluster id to identify the current node type
    -- of this cluster and from that to create a list of node types you can
    -- scale up to.
    --
    -- You must provide a value for either the @CacheClusterId@ or the
    -- @ReplicationGroupId@.
    ListAllowedNodeTypeModifications -> Maybe Text
cacheClusterId :: Prelude.Maybe Prelude.Text,
    -- | The name of the replication group want to scale up to a larger node
    -- type. ElastiCache uses the replication group id to identify the current
    -- node type being used by this replication group, and from that to create
    -- a list of node types you can scale up to.
    --
    -- You must provide a value for either the @CacheClusterId@ or the
    -- @ReplicationGroupId@.
    ListAllowedNodeTypeModifications -> Maybe Text
replicationGroupId :: Prelude.Maybe Prelude.Text
  }
  deriving (ListAllowedNodeTypeModifications
-> ListAllowedNodeTypeModifications -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ListAllowedNodeTypeModifications
-> ListAllowedNodeTypeModifications -> Bool
$c/= :: ListAllowedNodeTypeModifications
-> ListAllowedNodeTypeModifications -> Bool
== :: ListAllowedNodeTypeModifications
-> ListAllowedNodeTypeModifications -> Bool
$c== :: ListAllowedNodeTypeModifications
-> ListAllowedNodeTypeModifications -> Bool
Prelude.Eq, ReadPrec [ListAllowedNodeTypeModifications]
ReadPrec ListAllowedNodeTypeModifications
Int -> ReadS ListAllowedNodeTypeModifications
ReadS [ListAllowedNodeTypeModifications]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ListAllowedNodeTypeModifications]
$creadListPrec :: ReadPrec [ListAllowedNodeTypeModifications]
readPrec :: ReadPrec ListAllowedNodeTypeModifications
$creadPrec :: ReadPrec ListAllowedNodeTypeModifications
readList :: ReadS [ListAllowedNodeTypeModifications]
$creadList :: ReadS [ListAllowedNodeTypeModifications]
readsPrec :: Int -> ReadS ListAllowedNodeTypeModifications
$creadsPrec :: Int -> ReadS ListAllowedNodeTypeModifications
Prelude.Read, Int -> ListAllowedNodeTypeModifications -> ShowS
[ListAllowedNodeTypeModifications] -> ShowS
ListAllowedNodeTypeModifications -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ListAllowedNodeTypeModifications] -> ShowS
$cshowList :: [ListAllowedNodeTypeModifications] -> ShowS
show :: ListAllowedNodeTypeModifications -> String
$cshow :: ListAllowedNodeTypeModifications -> String
showsPrec :: Int -> ListAllowedNodeTypeModifications -> ShowS
$cshowsPrec :: Int -> ListAllowedNodeTypeModifications -> ShowS
Prelude.Show, forall x.
Rep ListAllowedNodeTypeModifications x
-> ListAllowedNodeTypeModifications
forall x.
ListAllowedNodeTypeModifications
-> Rep ListAllowedNodeTypeModifications x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep ListAllowedNodeTypeModifications x
-> ListAllowedNodeTypeModifications
$cfrom :: forall x.
ListAllowedNodeTypeModifications
-> Rep ListAllowedNodeTypeModifications x
Prelude.Generic)

-- |
-- Create a value of 'ListAllowedNodeTypeModifications' 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:
--
-- 'cacheClusterId', 'listAllowedNodeTypeModifications_cacheClusterId' - The name of the cluster you want to scale up to a larger node instanced
-- type. ElastiCache uses the cluster id to identify the current node type
-- of this cluster and from that to create a list of node types you can
-- scale up to.
--
-- You must provide a value for either the @CacheClusterId@ or the
-- @ReplicationGroupId@.
--
-- 'replicationGroupId', 'listAllowedNodeTypeModifications_replicationGroupId' - The name of the replication group want to scale up to a larger node
-- type. ElastiCache uses the replication group id to identify the current
-- node type being used by this replication group, and from that to create
-- a list of node types you can scale up to.
--
-- You must provide a value for either the @CacheClusterId@ or the
-- @ReplicationGroupId@.
newListAllowedNodeTypeModifications ::
  ListAllowedNodeTypeModifications
newListAllowedNodeTypeModifications :: ListAllowedNodeTypeModifications
newListAllowedNodeTypeModifications =
  ListAllowedNodeTypeModifications'
    { $sel:cacheClusterId:ListAllowedNodeTypeModifications' :: Maybe Text
cacheClusterId =
        forall a. Maybe a
Prelude.Nothing,
      $sel:replicationGroupId:ListAllowedNodeTypeModifications' :: Maybe Text
replicationGroupId = forall a. Maybe a
Prelude.Nothing
    }

-- | The name of the cluster you want to scale up to a larger node instanced
-- type. ElastiCache uses the cluster id to identify the current node type
-- of this cluster and from that to create a list of node types you can
-- scale up to.
--
-- You must provide a value for either the @CacheClusterId@ or the
-- @ReplicationGroupId@.
listAllowedNodeTypeModifications_cacheClusterId :: Lens.Lens' ListAllowedNodeTypeModifications (Prelude.Maybe Prelude.Text)
listAllowedNodeTypeModifications_cacheClusterId :: Lens' ListAllowedNodeTypeModifications (Maybe Text)
listAllowedNodeTypeModifications_cacheClusterId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListAllowedNodeTypeModifications' {Maybe Text
cacheClusterId :: Maybe Text
$sel:cacheClusterId:ListAllowedNodeTypeModifications' :: ListAllowedNodeTypeModifications -> Maybe Text
cacheClusterId} -> Maybe Text
cacheClusterId) (\s :: ListAllowedNodeTypeModifications
s@ListAllowedNodeTypeModifications' {} Maybe Text
a -> ListAllowedNodeTypeModifications
s {$sel:cacheClusterId:ListAllowedNodeTypeModifications' :: Maybe Text
cacheClusterId = Maybe Text
a} :: ListAllowedNodeTypeModifications)

-- | The name of the replication group want to scale up to a larger node
-- type. ElastiCache uses the replication group id to identify the current
-- node type being used by this replication group, and from that to create
-- a list of node types you can scale up to.
--
-- You must provide a value for either the @CacheClusterId@ or the
-- @ReplicationGroupId@.
listAllowedNodeTypeModifications_replicationGroupId :: Lens.Lens' ListAllowedNodeTypeModifications (Prelude.Maybe Prelude.Text)
listAllowedNodeTypeModifications_replicationGroupId :: Lens' ListAllowedNodeTypeModifications (Maybe Text)
listAllowedNodeTypeModifications_replicationGroupId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListAllowedNodeTypeModifications' {Maybe Text
replicationGroupId :: Maybe Text
$sel:replicationGroupId:ListAllowedNodeTypeModifications' :: ListAllowedNodeTypeModifications -> Maybe Text
replicationGroupId} -> Maybe Text
replicationGroupId) (\s :: ListAllowedNodeTypeModifications
s@ListAllowedNodeTypeModifications' {} Maybe Text
a -> ListAllowedNodeTypeModifications
s {$sel:replicationGroupId:ListAllowedNodeTypeModifications' :: Maybe Text
replicationGroupId = Maybe Text
a} :: ListAllowedNodeTypeModifications)

instance
  Core.AWSRequest
    ListAllowedNodeTypeModifications
  where
  type
    AWSResponse ListAllowedNodeTypeModifications =
      ListAllowedNodeTypeModificationsResponse
  request :: (Service -> Service)
-> ListAllowedNodeTypeModifications
-> Request ListAllowedNodeTypeModifications
request Service -> Service
overrides =
    forall a. ToRequest a => Service -> a -> Request a
Request.postQuery (Service -> Service
overrides Service
defaultService)
  response :: forall (m :: * -> *).
MonadResource m =>
(ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy ListAllowedNodeTypeModifications
-> ClientResponse ClientBody
-> m (Either
        Error
        (ClientResponse (AWSResponse ListAllowedNodeTypeModifications)))
response =
    forall (m :: * -> *) a.
MonadResource m =>
Text
-> (Int
    -> ResponseHeaders -> [Node] -> Either String (AWSResponse a))
-> (ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy a
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse a)))
Response.receiveXMLWrapper
      Text
"ListAllowedNodeTypeModificationsResult"
      ( \Int
s ResponseHeaders
h [Node]
x ->
          Maybe [Text]
-> Maybe [Text] -> Int -> ListAllowedNodeTypeModificationsResponse
ListAllowedNodeTypeModificationsResponse'
            forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> ( [Node]
x
                            forall a. FromXML a => [Node] -> Text -> Either String (Maybe a)
Data..@? Text
"ScaleDownModifications"
                            forall (f :: * -> *) a. Functor f => f (Maybe a) -> a -> f a
Core..!@ forall a. Monoid a => a
Prelude.mempty
                            forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
Prelude.>>= forall (f :: * -> *) a b.
Applicative f =>
([a] -> f b) -> [a] -> f (Maybe b)
Core.may (forall a. FromXML a => Text -> [Node] -> Either String [a]
Data.parseXMLList Text
"member")
                        )
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> ( [Node]
x
                            forall a. FromXML a => [Node] -> Text -> Either String (Maybe a)
Data..@? Text
"ScaleUpModifications"
                            forall (f :: * -> *) a. Functor f => f (Maybe a) -> a -> f a
Core..!@ forall a. Monoid a => a
Prelude.mempty
                            forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
Prelude.>>= forall (f :: * -> *) a b.
Applicative f =>
([a] -> f b) -> [a] -> f (Maybe b)
Core.may (forall a. FromXML a => Text -> [Node] -> Either String [a]
Data.parseXMLList Text
"member")
                        )
            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
    ListAllowedNodeTypeModifications
  where
  hashWithSalt :: Int -> ListAllowedNodeTypeModifications -> Int
hashWithSalt
    Int
_salt
    ListAllowedNodeTypeModifications' {Maybe Text
replicationGroupId :: Maybe Text
cacheClusterId :: Maybe Text
$sel:replicationGroupId:ListAllowedNodeTypeModifications' :: ListAllowedNodeTypeModifications -> Maybe Text
$sel:cacheClusterId:ListAllowedNodeTypeModifications' :: ListAllowedNodeTypeModifications -> Maybe Text
..} =
      Int
_salt
        forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
cacheClusterId
        forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
replicationGroupId

instance
  Prelude.NFData
    ListAllowedNodeTypeModifications
  where
  rnf :: ListAllowedNodeTypeModifications -> ()
rnf ListAllowedNodeTypeModifications' {Maybe Text
replicationGroupId :: Maybe Text
cacheClusterId :: Maybe Text
$sel:replicationGroupId:ListAllowedNodeTypeModifications' :: ListAllowedNodeTypeModifications -> Maybe Text
$sel:cacheClusterId:ListAllowedNodeTypeModifications' :: ListAllowedNodeTypeModifications -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
cacheClusterId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
replicationGroupId

instance
  Data.ToHeaders
    ListAllowedNodeTypeModifications
  where
  toHeaders :: ListAllowedNodeTypeModifications -> ResponseHeaders
toHeaders = forall a b. a -> b -> a
Prelude.const forall a. Monoid a => a
Prelude.mempty

instance Data.ToPath ListAllowedNodeTypeModifications where
  toPath :: ListAllowedNodeTypeModifications -> ByteString
toPath = forall a b. a -> b -> a
Prelude.const ByteString
"/"

instance
  Data.ToQuery
    ListAllowedNodeTypeModifications
  where
  toQuery :: ListAllowedNodeTypeModifications -> QueryString
toQuery ListAllowedNodeTypeModifications' {Maybe Text
replicationGroupId :: Maybe Text
cacheClusterId :: Maybe Text
$sel:replicationGroupId:ListAllowedNodeTypeModifications' :: ListAllowedNodeTypeModifications -> Maybe Text
$sel:cacheClusterId:ListAllowedNodeTypeModifications' :: ListAllowedNodeTypeModifications -> Maybe Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"Action"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: ( ByteString
"ListAllowedNodeTypeModifications" ::
                      Prelude.ByteString
                  ),
        ByteString
"Version"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: (ByteString
"2015-02-02" :: Prelude.ByteString),
        ByteString
"CacheClusterId" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Text
cacheClusterId,
        ByteString
"ReplicationGroupId" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Text
replicationGroupId
      ]

-- | Represents the allowed node types you can use to modify your cluster or
-- replication group.
--
-- /See:/ 'newListAllowedNodeTypeModificationsResponse' smart constructor.
data ListAllowedNodeTypeModificationsResponse = ListAllowedNodeTypeModificationsResponse'
  { -- | A string list, each element of which specifies a cache node type which
    -- you can use to scale your cluster or replication group. When scaling
    -- down a Redis cluster or replication group using ModifyCacheCluster or
    -- ModifyReplicationGroup, use a value from this list for the CacheNodeType
    -- parameter.
    ListAllowedNodeTypeModificationsResponse -> Maybe [Text]
scaleDownModifications :: Prelude.Maybe [Prelude.Text],
    -- | A string list, each element of which specifies a cache node type which
    -- you can use to scale your cluster or replication group.
    --
    -- When scaling up a Redis cluster or replication group using
    -- @ModifyCacheCluster@ or @ModifyReplicationGroup@, use a value from this
    -- list for the @CacheNodeType@ parameter.
    ListAllowedNodeTypeModificationsResponse -> Maybe [Text]
scaleUpModifications :: Prelude.Maybe [Prelude.Text],
    -- | The response's http status code.
    ListAllowedNodeTypeModificationsResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (ListAllowedNodeTypeModificationsResponse
-> ListAllowedNodeTypeModificationsResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ListAllowedNodeTypeModificationsResponse
-> ListAllowedNodeTypeModificationsResponse -> Bool
$c/= :: ListAllowedNodeTypeModificationsResponse
-> ListAllowedNodeTypeModificationsResponse -> Bool
== :: ListAllowedNodeTypeModificationsResponse
-> ListAllowedNodeTypeModificationsResponse -> Bool
$c== :: ListAllowedNodeTypeModificationsResponse
-> ListAllowedNodeTypeModificationsResponse -> Bool
Prelude.Eq, ReadPrec [ListAllowedNodeTypeModificationsResponse]
ReadPrec ListAllowedNodeTypeModificationsResponse
Int -> ReadS ListAllowedNodeTypeModificationsResponse
ReadS [ListAllowedNodeTypeModificationsResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ListAllowedNodeTypeModificationsResponse]
$creadListPrec :: ReadPrec [ListAllowedNodeTypeModificationsResponse]
readPrec :: ReadPrec ListAllowedNodeTypeModificationsResponse
$creadPrec :: ReadPrec ListAllowedNodeTypeModificationsResponse
readList :: ReadS [ListAllowedNodeTypeModificationsResponse]
$creadList :: ReadS [ListAllowedNodeTypeModificationsResponse]
readsPrec :: Int -> ReadS ListAllowedNodeTypeModificationsResponse
$creadsPrec :: Int -> ReadS ListAllowedNodeTypeModificationsResponse
Prelude.Read, Int -> ListAllowedNodeTypeModificationsResponse -> ShowS
[ListAllowedNodeTypeModificationsResponse] -> ShowS
ListAllowedNodeTypeModificationsResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ListAllowedNodeTypeModificationsResponse] -> ShowS
$cshowList :: [ListAllowedNodeTypeModificationsResponse] -> ShowS
show :: ListAllowedNodeTypeModificationsResponse -> String
$cshow :: ListAllowedNodeTypeModificationsResponse -> String
showsPrec :: Int -> ListAllowedNodeTypeModificationsResponse -> ShowS
$cshowsPrec :: Int -> ListAllowedNodeTypeModificationsResponse -> ShowS
Prelude.Show, forall x.
Rep ListAllowedNodeTypeModificationsResponse x
-> ListAllowedNodeTypeModificationsResponse
forall x.
ListAllowedNodeTypeModificationsResponse
-> Rep ListAllowedNodeTypeModificationsResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep ListAllowedNodeTypeModificationsResponse x
-> ListAllowedNodeTypeModificationsResponse
$cfrom :: forall x.
ListAllowedNodeTypeModificationsResponse
-> Rep ListAllowedNodeTypeModificationsResponse x
Prelude.Generic)

-- |
-- Create a value of 'ListAllowedNodeTypeModificationsResponse' 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:
--
-- 'scaleDownModifications', 'listAllowedNodeTypeModificationsResponse_scaleDownModifications' - A string list, each element of which specifies a cache node type which
-- you can use to scale your cluster or replication group. When scaling
-- down a Redis cluster or replication group using ModifyCacheCluster or
-- ModifyReplicationGroup, use a value from this list for the CacheNodeType
-- parameter.
--
-- 'scaleUpModifications', 'listAllowedNodeTypeModificationsResponse_scaleUpModifications' - A string list, each element of which specifies a cache node type which
-- you can use to scale your cluster or replication group.
--
-- When scaling up a Redis cluster or replication group using
-- @ModifyCacheCluster@ or @ModifyReplicationGroup@, use a value from this
-- list for the @CacheNodeType@ parameter.
--
-- 'httpStatus', 'listAllowedNodeTypeModificationsResponse_httpStatus' - The response's http status code.
newListAllowedNodeTypeModificationsResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  ListAllowedNodeTypeModificationsResponse
newListAllowedNodeTypeModificationsResponse :: Int -> ListAllowedNodeTypeModificationsResponse
newListAllowedNodeTypeModificationsResponse
  Int
pHttpStatus_ =
    ListAllowedNodeTypeModificationsResponse'
      { $sel:scaleDownModifications:ListAllowedNodeTypeModificationsResponse' :: Maybe [Text]
scaleDownModifications =
          forall a. Maybe a
Prelude.Nothing,
        $sel:scaleUpModifications:ListAllowedNodeTypeModificationsResponse' :: Maybe [Text]
scaleUpModifications =
          forall a. Maybe a
Prelude.Nothing,
        $sel:httpStatus:ListAllowedNodeTypeModificationsResponse' :: Int
httpStatus = Int
pHttpStatus_
      }

-- | A string list, each element of which specifies a cache node type which
-- you can use to scale your cluster or replication group. When scaling
-- down a Redis cluster or replication group using ModifyCacheCluster or
-- ModifyReplicationGroup, use a value from this list for the CacheNodeType
-- parameter.
listAllowedNodeTypeModificationsResponse_scaleDownModifications :: Lens.Lens' ListAllowedNodeTypeModificationsResponse (Prelude.Maybe [Prelude.Text])
listAllowedNodeTypeModificationsResponse_scaleDownModifications :: Lens' ListAllowedNodeTypeModificationsResponse (Maybe [Text])
listAllowedNodeTypeModificationsResponse_scaleDownModifications = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListAllowedNodeTypeModificationsResponse' {Maybe [Text]
scaleDownModifications :: Maybe [Text]
$sel:scaleDownModifications:ListAllowedNodeTypeModificationsResponse' :: ListAllowedNodeTypeModificationsResponse -> Maybe [Text]
scaleDownModifications} -> Maybe [Text]
scaleDownModifications) (\s :: ListAllowedNodeTypeModificationsResponse
s@ListAllowedNodeTypeModificationsResponse' {} Maybe [Text]
a -> ListAllowedNodeTypeModificationsResponse
s {$sel:scaleDownModifications:ListAllowedNodeTypeModificationsResponse' :: Maybe [Text]
scaleDownModifications = Maybe [Text]
a} :: ListAllowedNodeTypeModificationsResponse) 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

-- | A string list, each element of which specifies a cache node type which
-- you can use to scale your cluster or replication group.
--
-- When scaling up a Redis cluster or replication group using
-- @ModifyCacheCluster@ or @ModifyReplicationGroup@, use a value from this
-- list for the @CacheNodeType@ parameter.
listAllowedNodeTypeModificationsResponse_scaleUpModifications :: Lens.Lens' ListAllowedNodeTypeModificationsResponse (Prelude.Maybe [Prelude.Text])
listAllowedNodeTypeModificationsResponse_scaleUpModifications :: Lens' ListAllowedNodeTypeModificationsResponse (Maybe [Text])
listAllowedNodeTypeModificationsResponse_scaleUpModifications = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListAllowedNodeTypeModificationsResponse' {Maybe [Text]
scaleUpModifications :: Maybe [Text]
$sel:scaleUpModifications:ListAllowedNodeTypeModificationsResponse' :: ListAllowedNodeTypeModificationsResponse -> Maybe [Text]
scaleUpModifications} -> Maybe [Text]
scaleUpModifications) (\s :: ListAllowedNodeTypeModificationsResponse
s@ListAllowedNodeTypeModificationsResponse' {} Maybe [Text]
a -> ListAllowedNodeTypeModificationsResponse
s {$sel:scaleUpModifications:ListAllowedNodeTypeModificationsResponse' :: Maybe [Text]
scaleUpModifications = Maybe [Text]
a} :: ListAllowedNodeTypeModificationsResponse) 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.
listAllowedNodeTypeModificationsResponse_httpStatus :: Lens.Lens' ListAllowedNodeTypeModificationsResponse Prelude.Int
listAllowedNodeTypeModificationsResponse_httpStatus :: Lens' ListAllowedNodeTypeModificationsResponse Int
listAllowedNodeTypeModificationsResponse_httpStatus = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListAllowedNodeTypeModificationsResponse' {Int
httpStatus :: Int
$sel:httpStatus:ListAllowedNodeTypeModificationsResponse' :: ListAllowedNodeTypeModificationsResponse -> Int
httpStatus} -> Int
httpStatus) (\s :: ListAllowedNodeTypeModificationsResponse
s@ListAllowedNodeTypeModificationsResponse' {} Int
a -> ListAllowedNodeTypeModificationsResponse
s {$sel:httpStatus:ListAllowedNodeTypeModificationsResponse' :: Int
httpStatus = Int
a} :: ListAllowedNodeTypeModificationsResponse)

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