{-# 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.Redshift.DescribeNodeConfigurationOptions
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Returns properties of possible node configurations such as node type,
-- number of nodes, and disk usage for the specified action type.
--
-- This operation returns paginated results.
module Amazonka.Redshift.DescribeNodeConfigurationOptions
  ( -- * Creating a Request
    DescribeNodeConfigurationOptions (..),
    newDescribeNodeConfigurationOptions,

    -- * Request Lenses
    describeNodeConfigurationOptions_clusterIdentifier,
    describeNodeConfigurationOptions_filters,
    describeNodeConfigurationOptions_marker,
    describeNodeConfigurationOptions_maxRecords,
    describeNodeConfigurationOptions_ownerAccount,
    describeNodeConfigurationOptions_snapshotArn,
    describeNodeConfigurationOptions_snapshotIdentifier,
    describeNodeConfigurationOptions_actionType,

    -- * Destructuring the Response
    DescribeNodeConfigurationOptionsResponse (..),
    newDescribeNodeConfigurationOptionsResponse,

    -- * Response Lenses
    describeNodeConfigurationOptionsResponse_marker,
    describeNodeConfigurationOptionsResponse_nodeConfigurationOptionList,
    describeNodeConfigurationOptionsResponse_httpStatus,
  )
where

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

-- | /See:/ 'newDescribeNodeConfigurationOptions' smart constructor.
data DescribeNodeConfigurationOptions = DescribeNodeConfigurationOptions'
  { -- | The identifier of the cluster to evaluate for possible node
    -- configurations.
    DescribeNodeConfigurationOptions -> Maybe Text
clusterIdentifier :: Prelude.Maybe Prelude.Text,
    -- | A set of name, operator, and value items to filter the results.
    DescribeNodeConfigurationOptions
-> Maybe [NodeConfigurationOptionsFilter]
filters :: Prelude.Maybe [NodeConfigurationOptionsFilter],
    -- | An optional parameter that specifies the starting point to return a set
    -- of response records. When the results of a
    -- DescribeNodeConfigurationOptions request exceed the value specified in
    -- @MaxRecords@, Amazon Web Services returns a value in the @Marker@ field
    -- of the response. You can retrieve the next set of response records by
    -- providing the returned marker value in the @Marker@ parameter and
    -- retrying the request.
    DescribeNodeConfigurationOptions -> Maybe Text
marker :: Prelude.Maybe Prelude.Text,
    -- | The maximum number of response records to return in each call. If the
    -- number of remaining response records exceeds the specified @MaxRecords@
    -- value, a value is returned in a @marker@ field of the response. You can
    -- retrieve the next set of records by retrying the command with the
    -- returned marker value.
    --
    -- Default: @500@
    --
    -- Constraints: minimum 100, maximum 500.
    DescribeNodeConfigurationOptions -> Maybe Int
maxRecords :: Prelude.Maybe Prelude.Int,
    -- | The Amazon Web Services account used to create or copy the snapshot.
    -- Required if you are restoring a snapshot you do not own, optional if you
    -- own the snapshot.
    DescribeNodeConfigurationOptions -> Maybe Text
ownerAccount :: Prelude.Maybe Prelude.Text,
    -- | The Amazon Resource Name (ARN) of the snapshot associated with the
    -- message to describe node configuration.
    DescribeNodeConfigurationOptions -> Maybe Text
snapshotArn :: Prelude.Maybe Prelude.Text,
    -- | The identifier of the snapshot to evaluate for possible node
    -- configurations.
    DescribeNodeConfigurationOptions -> Maybe Text
snapshotIdentifier :: Prelude.Maybe Prelude.Text,
    -- | The action type to evaluate for possible node configurations. Specify
    -- \"restore-cluster\" to get configuration combinations based on an
    -- existing snapshot. Specify \"recommend-node-config\" to get
    -- configuration recommendations based on an existing cluster or snapshot.
    -- Specify \"resize-cluster\" to get configuration combinations for elastic
    -- resize based on an existing cluster.
    DescribeNodeConfigurationOptions -> ActionType
actionType :: ActionType
  }
  deriving (DescribeNodeConfigurationOptions
-> DescribeNodeConfigurationOptions -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DescribeNodeConfigurationOptions
-> DescribeNodeConfigurationOptions -> Bool
$c/= :: DescribeNodeConfigurationOptions
-> DescribeNodeConfigurationOptions -> Bool
== :: DescribeNodeConfigurationOptions
-> DescribeNodeConfigurationOptions -> Bool
$c== :: DescribeNodeConfigurationOptions
-> DescribeNodeConfigurationOptions -> Bool
Prelude.Eq, ReadPrec [DescribeNodeConfigurationOptions]
ReadPrec DescribeNodeConfigurationOptions
Int -> ReadS DescribeNodeConfigurationOptions
ReadS [DescribeNodeConfigurationOptions]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DescribeNodeConfigurationOptions]
$creadListPrec :: ReadPrec [DescribeNodeConfigurationOptions]
readPrec :: ReadPrec DescribeNodeConfigurationOptions
$creadPrec :: ReadPrec DescribeNodeConfigurationOptions
readList :: ReadS [DescribeNodeConfigurationOptions]
$creadList :: ReadS [DescribeNodeConfigurationOptions]
readsPrec :: Int -> ReadS DescribeNodeConfigurationOptions
$creadsPrec :: Int -> ReadS DescribeNodeConfigurationOptions
Prelude.Read, Int -> DescribeNodeConfigurationOptions -> ShowS
[DescribeNodeConfigurationOptions] -> ShowS
DescribeNodeConfigurationOptions -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DescribeNodeConfigurationOptions] -> ShowS
$cshowList :: [DescribeNodeConfigurationOptions] -> ShowS
show :: DescribeNodeConfigurationOptions -> String
$cshow :: DescribeNodeConfigurationOptions -> String
showsPrec :: Int -> DescribeNodeConfigurationOptions -> ShowS
$cshowsPrec :: Int -> DescribeNodeConfigurationOptions -> ShowS
Prelude.Show, forall x.
Rep DescribeNodeConfigurationOptions x
-> DescribeNodeConfigurationOptions
forall x.
DescribeNodeConfigurationOptions
-> Rep DescribeNodeConfigurationOptions x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep DescribeNodeConfigurationOptions x
-> DescribeNodeConfigurationOptions
$cfrom :: forall x.
DescribeNodeConfigurationOptions
-> Rep DescribeNodeConfigurationOptions x
Prelude.Generic)

-- |
-- Create a value of 'DescribeNodeConfigurationOptions' 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:
--
-- 'clusterIdentifier', 'describeNodeConfigurationOptions_clusterIdentifier' - The identifier of the cluster to evaluate for possible node
-- configurations.
--
-- 'filters', 'describeNodeConfigurationOptions_filters' - A set of name, operator, and value items to filter the results.
--
-- 'marker', 'describeNodeConfigurationOptions_marker' - An optional parameter that specifies the starting point to return a set
-- of response records. When the results of a
-- DescribeNodeConfigurationOptions request exceed the value specified in
-- @MaxRecords@, Amazon Web Services returns a value in the @Marker@ field
-- of the response. You can retrieve the next set of response records by
-- providing the returned marker value in the @Marker@ parameter and
-- retrying the request.
--
-- 'maxRecords', 'describeNodeConfigurationOptions_maxRecords' - The maximum number of response records to return in each call. If the
-- number of remaining response records exceeds the specified @MaxRecords@
-- value, a value is returned in a @marker@ field of the response. You can
-- retrieve the next set of records by retrying the command with the
-- returned marker value.
--
-- Default: @500@
--
-- Constraints: minimum 100, maximum 500.
--
-- 'ownerAccount', 'describeNodeConfigurationOptions_ownerAccount' - The Amazon Web Services account used to create or copy the snapshot.
-- Required if you are restoring a snapshot you do not own, optional if you
-- own the snapshot.
--
-- 'snapshotArn', 'describeNodeConfigurationOptions_snapshotArn' - The Amazon Resource Name (ARN) of the snapshot associated with the
-- message to describe node configuration.
--
-- 'snapshotIdentifier', 'describeNodeConfigurationOptions_snapshotIdentifier' - The identifier of the snapshot to evaluate for possible node
-- configurations.
--
-- 'actionType', 'describeNodeConfigurationOptions_actionType' - The action type to evaluate for possible node configurations. Specify
-- \"restore-cluster\" to get configuration combinations based on an
-- existing snapshot. Specify \"recommend-node-config\" to get
-- configuration recommendations based on an existing cluster or snapshot.
-- Specify \"resize-cluster\" to get configuration combinations for elastic
-- resize based on an existing cluster.
newDescribeNodeConfigurationOptions ::
  -- | 'actionType'
  ActionType ->
  DescribeNodeConfigurationOptions
newDescribeNodeConfigurationOptions :: ActionType -> DescribeNodeConfigurationOptions
newDescribeNodeConfigurationOptions ActionType
pActionType_ =
  DescribeNodeConfigurationOptions'
    { $sel:clusterIdentifier:DescribeNodeConfigurationOptions' :: Maybe Text
clusterIdentifier =
        forall a. Maybe a
Prelude.Nothing,
      $sel:filters:DescribeNodeConfigurationOptions' :: Maybe [NodeConfigurationOptionsFilter]
filters = forall a. Maybe a
Prelude.Nothing,
      $sel:marker:DescribeNodeConfigurationOptions' :: Maybe Text
marker = forall a. Maybe a
Prelude.Nothing,
      $sel:maxRecords:DescribeNodeConfigurationOptions' :: Maybe Int
maxRecords = forall a. Maybe a
Prelude.Nothing,
      $sel:ownerAccount:DescribeNodeConfigurationOptions' :: Maybe Text
ownerAccount = forall a. Maybe a
Prelude.Nothing,
      $sel:snapshotArn:DescribeNodeConfigurationOptions' :: Maybe Text
snapshotArn = forall a. Maybe a
Prelude.Nothing,
      $sel:snapshotIdentifier:DescribeNodeConfigurationOptions' :: Maybe Text
snapshotIdentifier = forall a. Maybe a
Prelude.Nothing,
      $sel:actionType:DescribeNodeConfigurationOptions' :: ActionType
actionType = ActionType
pActionType_
    }

-- | The identifier of the cluster to evaluate for possible node
-- configurations.
describeNodeConfigurationOptions_clusterIdentifier :: Lens.Lens' DescribeNodeConfigurationOptions (Prelude.Maybe Prelude.Text)
describeNodeConfigurationOptions_clusterIdentifier :: Lens' DescribeNodeConfigurationOptions (Maybe Text)
describeNodeConfigurationOptions_clusterIdentifier = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeNodeConfigurationOptions' {Maybe Text
clusterIdentifier :: Maybe Text
$sel:clusterIdentifier:DescribeNodeConfigurationOptions' :: DescribeNodeConfigurationOptions -> Maybe Text
clusterIdentifier} -> Maybe Text
clusterIdentifier) (\s :: DescribeNodeConfigurationOptions
s@DescribeNodeConfigurationOptions' {} Maybe Text
a -> DescribeNodeConfigurationOptions
s {$sel:clusterIdentifier:DescribeNodeConfigurationOptions' :: Maybe Text
clusterIdentifier = Maybe Text
a} :: DescribeNodeConfigurationOptions)

-- | A set of name, operator, and value items to filter the results.
describeNodeConfigurationOptions_filters :: Lens.Lens' DescribeNodeConfigurationOptions (Prelude.Maybe [NodeConfigurationOptionsFilter])
describeNodeConfigurationOptions_filters :: Lens'
  DescribeNodeConfigurationOptions
  (Maybe [NodeConfigurationOptionsFilter])
describeNodeConfigurationOptions_filters = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeNodeConfigurationOptions' {Maybe [NodeConfigurationOptionsFilter]
filters :: Maybe [NodeConfigurationOptionsFilter]
$sel:filters:DescribeNodeConfigurationOptions' :: DescribeNodeConfigurationOptions
-> Maybe [NodeConfigurationOptionsFilter]
filters} -> Maybe [NodeConfigurationOptionsFilter]
filters) (\s :: DescribeNodeConfigurationOptions
s@DescribeNodeConfigurationOptions' {} Maybe [NodeConfigurationOptionsFilter]
a -> DescribeNodeConfigurationOptions
s {$sel:filters:DescribeNodeConfigurationOptions' :: Maybe [NodeConfigurationOptionsFilter]
filters = Maybe [NodeConfigurationOptionsFilter]
a} :: DescribeNodeConfigurationOptions) 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

-- | An optional parameter that specifies the starting point to return a set
-- of response records. When the results of a
-- DescribeNodeConfigurationOptions request exceed the value specified in
-- @MaxRecords@, Amazon Web Services returns a value in the @Marker@ field
-- of the response. You can retrieve the next set of response records by
-- providing the returned marker value in the @Marker@ parameter and
-- retrying the request.
describeNodeConfigurationOptions_marker :: Lens.Lens' DescribeNodeConfigurationOptions (Prelude.Maybe Prelude.Text)
describeNodeConfigurationOptions_marker :: Lens' DescribeNodeConfigurationOptions (Maybe Text)
describeNodeConfigurationOptions_marker = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeNodeConfigurationOptions' {Maybe Text
marker :: Maybe Text
$sel:marker:DescribeNodeConfigurationOptions' :: DescribeNodeConfigurationOptions -> Maybe Text
marker} -> Maybe Text
marker) (\s :: DescribeNodeConfigurationOptions
s@DescribeNodeConfigurationOptions' {} Maybe Text
a -> DescribeNodeConfigurationOptions
s {$sel:marker:DescribeNodeConfigurationOptions' :: Maybe Text
marker = Maybe Text
a} :: DescribeNodeConfigurationOptions)

-- | The maximum number of response records to return in each call. If the
-- number of remaining response records exceeds the specified @MaxRecords@
-- value, a value is returned in a @marker@ field of the response. You can
-- retrieve the next set of records by retrying the command with the
-- returned marker value.
--
-- Default: @500@
--
-- Constraints: minimum 100, maximum 500.
describeNodeConfigurationOptions_maxRecords :: Lens.Lens' DescribeNodeConfigurationOptions (Prelude.Maybe Prelude.Int)
describeNodeConfigurationOptions_maxRecords :: Lens' DescribeNodeConfigurationOptions (Maybe Int)
describeNodeConfigurationOptions_maxRecords = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeNodeConfigurationOptions' {Maybe Int
maxRecords :: Maybe Int
$sel:maxRecords:DescribeNodeConfigurationOptions' :: DescribeNodeConfigurationOptions -> Maybe Int
maxRecords} -> Maybe Int
maxRecords) (\s :: DescribeNodeConfigurationOptions
s@DescribeNodeConfigurationOptions' {} Maybe Int
a -> DescribeNodeConfigurationOptions
s {$sel:maxRecords:DescribeNodeConfigurationOptions' :: Maybe Int
maxRecords = Maybe Int
a} :: DescribeNodeConfigurationOptions)

-- | The Amazon Web Services account used to create or copy the snapshot.
-- Required if you are restoring a snapshot you do not own, optional if you
-- own the snapshot.
describeNodeConfigurationOptions_ownerAccount :: Lens.Lens' DescribeNodeConfigurationOptions (Prelude.Maybe Prelude.Text)
describeNodeConfigurationOptions_ownerAccount :: Lens' DescribeNodeConfigurationOptions (Maybe Text)
describeNodeConfigurationOptions_ownerAccount = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeNodeConfigurationOptions' {Maybe Text
ownerAccount :: Maybe Text
$sel:ownerAccount:DescribeNodeConfigurationOptions' :: DescribeNodeConfigurationOptions -> Maybe Text
ownerAccount} -> Maybe Text
ownerAccount) (\s :: DescribeNodeConfigurationOptions
s@DescribeNodeConfigurationOptions' {} Maybe Text
a -> DescribeNodeConfigurationOptions
s {$sel:ownerAccount:DescribeNodeConfigurationOptions' :: Maybe Text
ownerAccount = Maybe Text
a} :: DescribeNodeConfigurationOptions)

-- | The Amazon Resource Name (ARN) of the snapshot associated with the
-- message to describe node configuration.
describeNodeConfigurationOptions_snapshotArn :: Lens.Lens' DescribeNodeConfigurationOptions (Prelude.Maybe Prelude.Text)
describeNodeConfigurationOptions_snapshotArn :: Lens' DescribeNodeConfigurationOptions (Maybe Text)
describeNodeConfigurationOptions_snapshotArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeNodeConfigurationOptions' {Maybe Text
snapshotArn :: Maybe Text
$sel:snapshotArn:DescribeNodeConfigurationOptions' :: DescribeNodeConfigurationOptions -> Maybe Text
snapshotArn} -> Maybe Text
snapshotArn) (\s :: DescribeNodeConfigurationOptions
s@DescribeNodeConfigurationOptions' {} Maybe Text
a -> DescribeNodeConfigurationOptions
s {$sel:snapshotArn:DescribeNodeConfigurationOptions' :: Maybe Text
snapshotArn = Maybe Text
a} :: DescribeNodeConfigurationOptions)

-- | The identifier of the snapshot to evaluate for possible node
-- configurations.
describeNodeConfigurationOptions_snapshotIdentifier :: Lens.Lens' DescribeNodeConfigurationOptions (Prelude.Maybe Prelude.Text)
describeNodeConfigurationOptions_snapshotIdentifier :: Lens' DescribeNodeConfigurationOptions (Maybe Text)
describeNodeConfigurationOptions_snapshotIdentifier = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeNodeConfigurationOptions' {Maybe Text
snapshotIdentifier :: Maybe Text
$sel:snapshotIdentifier:DescribeNodeConfigurationOptions' :: DescribeNodeConfigurationOptions -> Maybe Text
snapshotIdentifier} -> Maybe Text
snapshotIdentifier) (\s :: DescribeNodeConfigurationOptions
s@DescribeNodeConfigurationOptions' {} Maybe Text
a -> DescribeNodeConfigurationOptions
s {$sel:snapshotIdentifier:DescribeNodeConfigurationOptions' :: Maybe Text
snapshotIdentifier = Maybe Text
a} :: DescribeNodeConfigurationOptions)

-- | The action type to evaluate for possible node configurations. Specify
-- \"restore-cluster\" to get configuration combinations based on an
-- existing snapshot. Specify \"recommend-node-config\" to get
-- configuration recommendations based on an existing cluster or snapshot.
-- Specify \"resize-cluster\" to get configuration combinations for elastic
-- resize based on an existing cluster.
describeNodeConfigurationOptions_actionType :: Lens.Lens' DescribeNodeConfigurationOptions ActionType
describeNodeConfigurationOptions_actionType :: Lens' DescribeNodeConfigurationOptions ActionType
describeNodeConfigurationOptions_actionType = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeNodeConfigurationOptions' {ActionType
actionType :: ActionType
$sel:actionType:DescribeNodeConfigurationOptions' :: DescribeNodeConfigurationOptions -> ActionType
actionType} -> ActionType
actionType) (\s :: DescribeNodeConfigurationOptions
s@DescribeNodeConfigurationOptions' {} ActionType
a -> DescribeNodeConfigurationOptions
s {$sel:actionType:DescribeNodeConfigurationOptions' :: ActionType
actionType = ActionType
a} :: DescribeNodeConfigurationOptions)

instance
  Core.AWSPager
    DescribeNodeConfigurationOptions
  where
  page :: DescribeNodeConfigurationOptions
-> AWSResponse DescribeNodeConfigurationOptions
-> Maybe DescribeNodeConfigurationOptions
page DescribeNodeConfigurationOptions
rq AWSResponse DescribeNodeConfigurationOptions
rs
    | forall a. AWSTruncated a => a -> Bool
Core.stop
        ( AWSResponse DescribeNodeConfigurationOptions
rs
            forall s a. s -> Getting (First a) s a -> Maybe a
Lens.^? Lens' DescribeNodeConfigurationOptionsResponse (Maybe Text)
describeNodeConfigurationOptionsResponse_marker
            forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall a b. Prism (Maybe a) (Maybe b) a b
Lens._Just
        ) =
        forall a. Maybe a
Prelude.Nothing
    | forall a. AWSTruncated a => a -> Bool
Core.stop
        ( AWSResponse DescribeNodeConfigurationOptions
rs
            forall s a. s -> Getting (First a) s a -> Maybe a
Lens.^? Lens'
  DescribeNodeConfigurationOptionsResponse
  (Maybe [NodeConfigurationOption])
describeNodeConfigurationOptionsResponse_nodeConfigurationOptionList
            forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall a b. Prism (Maybe a) (Maybe b) a b
Lens._Just
        ) =
        forall a. Maybe a
Prelude.Nothing
    | Bool
Prelude.otherwise =
        forall a. a -> Maybe a
Prelude.Just
          forall a b. (a -> b) -> a -> b
Prelude.$ DescribeNodeConfigurationOptions
rq
          forall a b. a -> (a -> b) -> b
Prelude.& Lens' DescribeNodeConfigurationOptions (Maybe Text)
describeNodeConfigurationOptions_marker
          forall s t a b. ASetter s t a b -> b -> s -> t
Lens..~ AWSResponse DescribeNodeConfigurationOptions
rs
          forall s a. s -> Getting (First a) s a -> Maybe a
Lens.^? Lens' DescribeNodeConfigurationOptionsResponse (Maybe Text)
describeNodeConfigurationOptionsResponse_marker
          forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall a b. Prism (Maybe a) (Maybe b) a b
Lens._Just

instance
  Core.AWSRequest
    DescribeNodeConfigurationOptions
  where
  type
    AWSResponse DescribeNodeConfigurationOptions =
      DescribeNodeConfigurationOptionsResponse
  request :: (Service -> Service)
-> DescribeNodeConfigurationOptions
-> Request DescribeNodeConfigurationOptions
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 DescribeNodeConfigurationOptions
-> ClientResponse ClientBody
-> m (Either
        Error
        (ClientResponse (AWSResponse DescribeNodeConfigurationOptions)))
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
"DescribeNodeConfigurationOptionsResult"
      ( \Int
s ResponseHeaders
h [Node]
x ->
          Maybe Text
-> Maybe [NodeConfigurationOption]
-> Int
-> DescribeNodeConfigurationOptionsResponse
DescribeNodeConfigurationOptionsResponse'
            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
"Marker")
            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
"NodeConfigurationOptionList"
                            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
"NodeConfigurationOption")
                        )
            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
    DescribeNodeConfigurationOptions
  where
  hashWithSalt :: Int -> DescribeNodeConfigurationOptions -> Int
hashWithSalt
    Int
_salt
    DescribeNodeConfigurationOptions' {Maybe Int
Maybe [NodeConfigurationOptionsFilter]
Maybe Text
ActionType
actionType :: ActionType
snapshotIdentifier :: Maybe Text
snapshotArn :: Maybe Text
ownerAccount :: Maybe Text
maxRecords :: Maybe Int
marker :: Maybe Text
filters :: Maybe [NodeConfigurationOptionsFilter]
clusterIdentifier :: Maybe Text
$sel:actionType:DescribeNodeConfigurationOptions' :: DescribeNodeConfigurationOptions -> ActionType
$sel:snapshotIdentifier:DescribeNodeConfigurationOptions' :: DescribeNodeConfigurationOptions -> Maybe Text
$sel:snapshotArn:DescribeNodeConfigurationOptions' :: DescribeNodeConfigurationOptions -> Maybe Text
$sel:ownerAccount:DescribeNodeConfigurationOptions' :: DescribeNodeConfigurationOptions -> Maybe Text
$sel:maxRecords:DescribeNodeConfigurationOptions' :: DescribeNodeConfigurationOptions -> Maybe Int
$sel:marker:DescribeNodeConfigurationOptions' :: DescribeNodeConfigurationOptions -> Maybe Text
$sel:filters:DescribeNodeConfigurationOptions' :: DescribeNodeConfigurationOptions
-> Maybe [NodeConfigurationOptionsFilter]
$sel:clusterIdentifier:DescribeNodeConfigurationOptions' :: DescribeNodeConfigurationOptions -> Maybe Text
..} =
      Int
_salt
        forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
clusterIdentifier
        forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [NodeConfigurationOptionsFilter]
filters
        forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
marker
        forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Int
maxRecords
        forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
ownerAccount
        forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
snapshotArn
        forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
snapshotIdentifier
        forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` ActionType
actionType

instance
  Prelude.NFData
    DescribeNodeConfigurationOptions
  where
  rnf :: DescribeNodeConfigurationOptions -> ()
rnf DescribeNodeConfigurationOptions' {Maybe Int
Maybe [NodeConfigurationOptionsFilter]
Maybe Text
ActionType
actionType :: ActionType
snapshotIdentifier :: Maybe Text
snapshotArn :: Maybe Text
ownerAccount :: Maybe Text
maxRecords :: Maybe Int
marker :: Maybe Text
filters :: Maybe [NodeConfigurationOptionsFilter]
clusterIdentifier :: Maybe Text
$sel:actionType:DescribeNodeConfigurationOptions' :: DescribeNodeConfigurationOptions -> ActionType
$sel:snapshotIdentifier:DescribeNodeConfigurationOptions' :: DescribeNodeConfigurationOptions -> Maybe Text
$sel:snapshotArn:DescribeNodeConfigurationOptions' :: DescribeNodeConfigurationOptions -> Maybe Text
$sel:ownerAccount:DescribeNodeConfigurationOptions' :: DescribeNodeConfigurationOptions -> Maybe Text
$sel:maxRecords:DescribeNodeConfigurationOptions' :: DescribeNodeConfigurationOptions -> Maybe Int
$sel:marker:DescribeNodeConfigurationOptions' :: DescribeNodeConfigurationOptions -> Maybe Text
$sel:filters:DescribeNodeConfigurationOptions' :: DescribeNodeConfigurationOptions
-> Maybe [NodeConfigurationOptionsFilter]
$sel:clusterIdentifier:DescribeNodeConfigurationOptions' :: DescribeNodeConfigurationOptions -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
clusterIdentifier
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [NodeConfigurationOptionsFilter]
filters
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
marker
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Int
maxRecords
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
ownerAccount
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
snapshotArn
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
snapshotIdentifier
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf ActionType
actionType

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

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

instance
  Data.ToQuery
    DescribeNodeConfigurationOptions
  where
  toQuery :: DescribeNodeConfigurationOptions -> QueryString
toQuery DescribeNodeConfigurationOptions' {Maybe Int
Maybe [NodeConfigurationOptionsFilter]
Maybe Text
ActionType
actionType :: ActionType
snapshotIdentifier :: Maybe Text
snapshotArn :: Maybe Text
ownerAccount :: Maybe Text
maxRecords :: Maybe Int
marker :: Maybe Text
filters :: Maybe [NodeConfigurationOptionsFilter]
clusterIdentifier :: Maybe Text
$sel:actionType:DescribeNodeConfigurationOptions' :: DescribeNodeConfigurationOptions -> ActionType
$sel:snapshotIdentifier:DescribeNodeConfigurationOptions' :: DescribeNodeConfigurationOptions -> Maybe Text
$sel:snapshotArn:DescribeNodeConfigurationOptions' :: DescribeNodeConfigurationOptions -> Maybe Text
$sel:ownerAccount:DescribeNodeConfigurationOptions' :: DescribeNodeConfigurationOptions -> Maybe Text
$sel:maxRecords:DescribeNodeConfigurationOptions' :: DescribeNodeConfigurationOptions -> Maybe Int
$sel:marker:DescribeNodeConfigurationOptions' :: DescribeNodeConfigurationOptions -> Maybe Text
$sel:filters:DescribeNodeConfigurationOptions' :: DescribeNodeConfigurationOptions
-> Maybe [NodeConfigurationOptionsFilter]
$sel:clusterIdentifier:DescribeNodeConfigurationOptions' :: DescribeNodeConfigurationOptions -> Maybe Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"Action"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: ( ByteString
"DescribeNodeConfigurationOptions" ::
                      Prelude.ByteString
                  ),
        ByteString
"Version"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: (ByteString
"2012-12-01" :: Prelude.ByteString),
        ByteString
"ClusterIdentifier" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Text
clusterIdentifier,
        ByteString
"Filter"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: forall a. ToQuery a => a -> QueryString
Data.toQuery
            ( forall a.
(IsList a, ToQuery (Item a)) =>
ByteString -> a -> QueryString
Data.toQueryList ByteString
"NodeConfigurationOptionsFilter"
                forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe [NodeConfigurationOptionsFilter]
filters
            ),
        ByteString
"Marker" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Text
marker,
        ByteString
"MaxRecords" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Int
maxRecords,
        ByteString
"OwnerAccount" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Text
ownerAccount,
        ByteString
"SnapshotArn" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Text
snapshotArn,
        ByteString
"SnapshotIdentifier" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Text
snapshotIdentifier,
        ByteString
"ActionType" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: ActionType
actionType
      ]

-- | /See:/ 'newDescribeNodeConfigurationOptionsResponse' smart constructor.
data DescribeNodeConfigurationOptionsResponse = DescribeNodeConfigurationOptionsResponse'
  { -- | A value that indicates the starting point for the next set of response
    -- records in a subsequent request. If a value is returned in a response,
    -- you can retrieve the next set of records by providing this returned
    -- marker value in the @Marker@ parameter and retrying the command. If the
    -- @Marker@ field is empty, all response records have been retrieved for
    -- the request.
    DescribeNodeConfigurationOptionsResponse -> Maybe Text
marker :: Prelude.Maybe Prelude.Text,
    -- | A list of valid node configurations.
    DescribeNodeConfigurationOptionsResponse
-> Maybe [NodeConfigurationOption]
nodeConfigurationOptionList :: Prelude.Maybe [NodeConfigurationOption],
    -- | The response's http status code.
    DescribeNodeConfigurationOptionsResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (DescribeNodeConfigurationOptionsResponse
-> DescribeNodeConfigurationOptionsResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DescribeNodeConfigurationOptionsResponse
-> DescribeNodeConfigurationOptionsResponse -> Bool
$c/= :: DescribeNodeConfigurationOptionsResponse
-> DescribeNodeConfigurationOptionsResponse -> Bool
== :: DescribeNodeConfigurationOptionsResponse
-> DescribeNodeConfigurationOptionsResponse -> Bool
$c== :: DescribeNodeConfigurationOptionsResponse
-> DescribeNodeConfigurationOptionsResponse -> Bool
Prelude.Eq, ReadPrec [DescribeNodeConfigurationOptionsResponse]
ReadPrec DescribeNodeConfigurationOptionsResponse
Int -> ReadS DescribeNodeConfigurationOptionsResponse
ReadS [DescribeNodeConfigurationOptionsResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DescribeNodeConfigurationOptionsResponse]
$creadListPrec :: ReadPrec [DescribeNodeConfigurationOptionsResponse]
readPrec :: ReadPrec DescribeNodeConfigurationOptionsResponse
$creadPrec :: ReadPrec DescribeNodeConfigurationOptionsResponse
readList :: ReadS [DescribeNodeConfigurationOptionsResponse]
$creadList :: ReadS [DescribeNodeConfigurationOptionsResponse]
readsPrec :: Int -> ReadS DescribeNodeConfigurationOptionsResponse
$creadsPrec :: Int -> ReadS DescribeNodeConfigurationOptionsResponse
Prelude.Read, Int -> DescribeNodeConfigurationOptionsResponse -> ShowS
[DescribeNodeConfigurationOptionsResponse] -> ShowS
DescribeNodeConfigurationOptionsResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DescribeNodeConfigurationOptionsResponse] -> ShowS
$cshowList :: [DescribeNodeConfigurationOptionsResponse] -> ShowS
show :: DescribeNodeConfigurationOptionsResponse -> String
$cshow :: DescribeNodeConfigurationOptionsResponse -> String
showsPrec :: Int -> DescribeNodeConfigurationOptionsResponse -> ShowS
$cshowsPrec :: Int -> DescribeNodeConfigurationOptionsResponse -> ShowS
Prelude.Show, forall x.
Rep DescribeNodeConfigurationOptionsResponse x
-> DescribeNodeConfigurationOptionsResponse
forall x.
DescribeNodeConfigurationOptionsResponse
-> Rep DescribeNodeConfigurationOptionsResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep DescribeNodeConfigurationOptionsResponse x
-> DescribeNodeConfigurationOptionsResponse
$cfrom :: forall x.
DescribeNodeConfigurationOptionsResponse
-> Rep DescribeNodeConfigurationOptionsResponse x
Prelude.Generic)

-- |
-- Create a value of 'DescribeNodeConfigurationOptionsResponse' 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:
--
-- 'marker', 'describeNodeConfigurationOptionsResponse_marker' - A value that indicates the starting point for the next set of response
-- records in a subsequent request. If a value is returned in a response,
-- you can retrieve the next set of records by providing this returned
-- marker value in the @Marker@ parameter and retrying the command. If the
-- @Marker@ field is empty, all response records have been retrieved for
-- the request.
--
-- 'nodeConfigurationOptionList', 'describeNodeConfigurationOptionsResponse_nodeConfigurationOptionList' - A list of valid node configurations.
--
-- 'httpStatus', 'describeNodeConfigurationOptionsResponse_httpStatus' - The response's http status code.
newDescribeNodeConfigurationOptionsResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  DescribeNodeConfigurationOptionsResponse
newDescribeNodeConfigurationOptionsResponse :: Int -> DescribeNodeConfigurationOptionsResponse
newDescribeNodeConfigurationOptionsResponse
  Int
pHttpStatus_ =
    DescribeNodeConfigurationOptionsResponse'
      { $sel:marker:DescribeNodeConfigurationOptionsResponse' :: Maybe Text
marker =
          forall a. Maybe a
Prelude.Nothing,
        $sel:nodeConfigurationOptionList:DescribeNodeConfigurationOptionsResponse' :: Maybe [NodeConfigurationOption]
nodeConfigurationOptionList =
          forall a. Maybe a
Prelude.Nothing,
        $sel:httpStatus:DescribeNodeConfigurationOptionsResponse' :: Int
httpStatus = Int
pHttpStatus_
      }

-- | A value that indicates the starting point for the next set of response
-- records in a subsequent request. If a value is returned in a response,
-- you can retrieve the next set of records by providing this returned
-- marker value in the @Marker@ parameter and retrying the command. If the
-- @Marker@ field is empty, all response records have been retrieved for
-- the request.
describeNodeConfigurationOptionsResponse_marker :: Lens.Lens' DescribeNodeConfigurationOptionsResponse (Prelude.Maybe Prelude.Text)
describeNodeConfigurationOptionsResponse_marker :: Lens' DescribeNodeConfigurationOptionsResponse (Maybe Text)
describeNodeConfigurationOptionsResponse_marker = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeNodeConfigurationOptionsResponse' {Maybe Text
marker :: Maybe Text
$sel:marker:DescribeNodeConfigurationOptionsResponse' :: DescribeNodeConfigurationOptionsResponse -> Maybe Text
marker} -> Maybe Text
marker) (\s :: DescribeNodeConfigurationOptionsResponse
s@DescribeNodeConfigurationOptionsResponse' {} Maybe Text
a -> DescribeNodeConfigurationOptionsResponse
s {$sel:marker:DescribeNodeConfigurationOptionsResponse' :: Maybe Text
marker = Maybe Text
a} :: DescribeNodeConfigurationOptionsResponse)

-- | A list of valid node configurations.
describeNodeConfigurationOptionsResponse_nodeConfigurationOptionList :: Lens.Lens' DescribeNodeConfigurationOptionsResponse (Prelude.Maybe [NodeConfigurationOption])
describeNodeConfigurationOptionsResponse_nodeConfigurationOptionList :: Lens'
  DescribeNodeConfigurationOptionsResponse
  (Maybe [NodeConfigurationOption])
describeNodeConfigurationOptionsResponse_nodeConfigurationOptionList = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeNodeConfigurationOptionsResponse' {Maybe [NodeConfigurationOption]
nodeConfigurationOptionList :: Maybe [NodeConfigurationOption]
$sel:nodeConfigurationOptionList:DescribeNodeConfigurationOptionsResponse' :: DescribeNodeConfigurationOptionsResponse
-> Maybe [NodeConfigurationOption]
nodeConfigurationOptionList} -> Maybe [NodeConfigurationOption]
nodeConfigurationOptionList) (\s :: DescribeNodeConfigurationOptionsResponse
s@DescribeNodeConfigurationOptionsResponse' {} Maybe [NodeConfigurationOption]
a -> DescribeNodeConfigurationOptionsResponse
s {$sel:nodeConfigurationOptionList:DescribeNodeConfigurationOptionsResponse' :: Maybe [NodeConfigurationOption]
nodeConfigurationOptionList = Maybe [NodeConfigurationOption]
a} :: DescribeNodeConfigurationOptionsResponse) 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.
describeNodeConfigurationOptionsResponse_httpStatus :: Lens.Lens' DescribeNodeConfigurationOptionsResponse Prelude.Int
describeNodeConfigurationOptionsResponse_httpStatus :: Lens' DescribeNodeConfigurationOptionsResponse Int
describeNodeConfigurationOptionsResponse_httpStatus = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeNodeConfigurationOptionsResponse' {Int
httpStatus :: Int
$sel:httpStatus:DescribeNodeConfigurationOptionsResponse' :: DescribeNodeConfigurationOptionsResponse -> Int
httpStatus} -> Int
httpStatus) (\s :: DescribeNodeConfigurationOptionsResponse
s@DescribeNodeConfigurationOptionsResponse' {} Int
a -> DescribeNodeConfigurationOptionsResponse
s {$sel:httpStatus:DescribeNodeConfigurationOptionsResponse' :: Int
httpStatus = Int
a} :: DescribeNodeConfigurationOptionsResponse)

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