{-# 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.CloudFormation.ListChangeSets
-- 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 the ID and status of each active change set for a stack. For
-- example, CloudFormation lists change sets that are in the
-- @CREATE_IN_PROGRESS@ or @CREATE_PENDING@ state.
--
-- This operation returns paginated results.
module Amazonka.CloudFormation.ListChangeSets
  ( -- * Creating a Request
    ListChangeSets (..),
    newListChangeSets,

    -- * Request Lenses
    listChangeSets_nextToken,
    listChangeSets_stackName,

    -- * Destructuring the Response
    ListChangeSetsResponse (..),
    newListChangeSetsResponse,

    -- * Response Lenses
    listChangeSetsResponse_nextToken,
    listChangeSetsResponse_summaries,
    listChangeSetsResponse_httpStatus,
  )
where

import Amazonka.CloudFormation.Types
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 qualified Amazonka.Request as Request
import qualified Amazonka.Response as Response

-- | The input for the ListChangeSets action.
--
-- /See:/ 'newListChangeSets' smart constructor.
data ListChangeSets = ListChangeSets'
  { -- | A string (provided by the ListChangeSets response output) that
    -- identifies the next page of change sets that you want to retrieve.
    ListChangeSets -> Maybe Text
nextToken :: Prelude.Maybe Prelude.Text,
    -- | The name or the Amazon Resource Name (ARN) of the stack for which you
    -- want to list change sets.
    ListChangeSets -> Text
stackName :: Prelude.Text
  }
  deriving (ListChangeSets -> ListChangeSets -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ListChangeSets -> ListChangeSets -> Bool
$c/= :: ListChangeSets -> ListChangeSets -> Bool
== :: ListChangeSets -> ListChangeSets -> Bool
$c== :: ListChangeSets -> ListChangeSets -> Bool
Prelude.Eq, ReadPrec [ListChangeSets]
ReadPrec ListChangeSets
Int -> ReadS ListChangeSets
ReadS [ListChangeSets]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ListChangeSets]
$creadListPrec :: ReadPrec [ListChangeSets]
readPrec :: ReadPrec ListChangeSets
$creadPrec :: ReadPrec ListChangeSets
readList :: ReadS [ListChangeSets]
$creadList :: ReadS [ListChangeSets]
readsPrec :: Int -> ReadS ListChangeSets
$creadsPrec :: Int -> ReadS ListChangeSets
Prelude.Read, Int -> ListChangeSets -> ShowS
[ListChangeSets] -> ShowS
ListChangeSets -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ListChangeSets] -> ShowS
$cshowList :: [ListChangeSets] -> ShowS
show :: ListChangeSets -> String
$cshow :: ListChangeSets -> String
showsPrec :: Int -> ListChangeSets -> ShowS
$cshowsPrec :: Int -> ListChangeSets -> ShowS
Prelude.Show, forall x. Rep ListChangeSets x -> ListChangeSets
forall x. ListChangeSets -> Rep ListChangeSets x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ListChangeSets x -> ListChangeSets
$cfrom :: forall x. ListChangeSets -> Rep ListChangeSets x
Prelude.Generic)

-- |
-- Create a value of 'ListChangeSets' 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:
--
-- 'nextToken', 'listChangeSets_nextToken' - A string (provided by the ListChangeSets response output) that
-- identifies the next page of change sets that you want to retrieve.
--
-- 'stackName', 'listChangeSets_stackName' - The name or the Amazon Resource Name (ARN) of the stack for which you
-- want to list change sets.
newListChangeSets ::
  -- | 'stackName'
  Prelude.Text ->
  ListChangeSets
newListChangeSets :: Text -> ListChangeSets
newListChangeSets Text
pStackName_ =
  ListChangeSets'
    { $sel:nextToken:ListChangeSets' :: Maybe Text
nextToken = forall a. Maybe a
Prelude.Nothing,
      $sel:stackName:ListChangeSets' :: Text
stackName = Text
pStackName_
    }

-- | A string (provided by the ListChangeSets response output) that
-- identifies the next page of change sets that you want to retrieve.
listChangeSets_nextToken :: Lens.Lens' ListChangeSets (Prelude.Maybe Prelude.Text)
listChangeSets_nextToken :: Lens' ListChangeSets (Maybe Text)
listChangeSets_nextToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListChangeSets' {Maybe Text
nextToken :: Maybe Text
$sel:nextToken:ListChangeSets' :: ListChangeSets -> Maybe Text
nextToken} -> Maybe Text
nextToken) (\s :: ListChangeSets
s@ListChangeSets' {} Maybe Text
a -> ListChangeSets
s {$sel:nextToken:ListChangeSets' :: Maybe Text
nextToken = Maybe Text
a} :: ListChangeSets)

-- | The name or the Amazon Resource Name (ARN) of the stack for which you
-- want to list change sets.
listChangeSets_stackName :: Lens.Lens' ListChangeSets Prelude.Text
listChangeSets_stackName :: Lens' ListChangeSets Text
listChangeSets_stackName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListChangeSets' {Text
stackName :: Text
$sel:stackName:ListChangeSets' :: ListChangeSets -> Text
stackName} -> Text
stackName) (\s :: ListChangeSets
s@ListChangeSets' {} Text
a -> ListChangeSets
s {$sel:stackName:ListChangeSets' :: Text
stackName = Text
a} :: ListChangeSets)

instance Core.AWSPager ListChangeSets where
  page :: ListChangeSets
-> AWSResponse ListChangeSets -> Maybe ListChangeSets
page ListChangeSets
rq AWSResponse ListChangeSets
rs
    | forall a. AWSTruncated a => a -> Bool
Core.stop
        ( AWSResponse ListChangeSets
rs
            forall s a. s -> Getting (First a) s a -> Maybe a
Lens.^? Lens' ListChangeSetsResponse (Maybe Text)
listChangeSetsResponse_nextToken
            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 ListChangeSets
rs
            forall s a. s -> Getting (First a) s a -> Maybe a
Lens.^? Lens' ListChangeSetsResponse (Maybe [ChangeSetSummary])
listChangeSetsResponse_summaries
            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.$ ListChangeSets
rq
          forall a b. a -> (a -> b) -> b
Prelude.& Lens' ListChangeSets (Maybe Text)
listChangeSets_nextToken
          forall s t a b. ASetter s t a b -> b -> s -> t
Lens..~ AWSResponse ListChangeSets
rs
          forall s a. s -> Getting (First a) s a -> Maybe a
Lens.^? Lens' ListChangeSetsResponse (Maybe Text)
listChangeSetsResponse_nextToken
          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 ListChangeSets where
  type
    AWSResponse ListChangeSets =
      ListChangeSetsResponse
  request :: (Service -> Service) -> ListChangeSets -> Request ListChangeSets
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 ListChangeSets
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse ListChangeSets)))
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
"ListChangeSetsResult"
      ( \Int
s ResponseHeaders
h [Node]
x ->
          Maybe Text
-> Maybe [ChangeSetSummary] -> Int -> ListChangeSetsResponse
ListChangeSetsResponse'
            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
"NextToken")
            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
"Summaries"
                            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 ListChangeSets where
  hashWithSalt :: Int -> ListChangeSets -> Int
hashWithSalt Int
_salt ListChangeSets' {Maybe Text
Text
stackName :: Text
nextToken :: Maybe Text
$sel:stackName:ListChangeSets' :: ListChangeSets -> Text
$sel:nextToken:ListChangeSets' :: ListChangeSets -> Maybe Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
nextToken
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
stackName

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

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

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

instance Data.ToQuery ListChangeSets where
  toQuery :: ListChangeSets -> QueryString
toQuery ListChangeSets' {Maybe Text
Text
stackName :: Text
nextToken :: Maybe Text
$sel:stackName:ListChangeSets' :: ListChangeSets -> Text
$sel:nextToken:ListChangeSets' :: ListChangeSets -> Maybe Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"Action"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: (ByteString
"ListChangeSets" :: Prelude.ByteString),
        ByteString
"Version"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: (ByteString
"2010-05-15" :: Prelude.ByteString),
        ByteString
"NextToken" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Text
nextToken,
        ByteString
"StackName" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Text
stackName
      ]

-- | The output for the ListChangeSets action.
--
-- /See:/ 'newListChangeSetsResponse' smart constructor.
data ListChangeSetsResponse = ListChangeSetsResponse'
  { -- | If the output exceeds 1 MB, a string that identifies the next page of
    -- change sets. If there is no additional page, this value is @null@.
    ListChangeSetsResponse -> Maybe Text
nextToken :: Prelude.Maybe Prelude.Text,
    -- | A list of @ChangeSetSummary@ structures that provides the ID and status
    -- of each change set for the specified stack.
    ListChangeSetsResponse -> Maybe [ChangeSetSummary]
summaries :: Prelude.Maybe [ChangeSetSummary],
    -- | The response's http status code.
    ListChangeSetsResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (ListChangeSetsResponse -> ListChangeSetsResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ListChangeSetsResponse -> ListChangeSetsResponse -> Bool
$c/= :: ListChangeSetsResponse -> ListChangeSetsResponse -> Bool
== :: ListChangeSetsResponse -> ListChangeSetsResponse -> Bool
$c== :: ListChangeSetsResponse -> ListChangeSetsResponse -> Bool
Prelude.Eq, ReadPrec [ListChangeSetsResponse]
ReadPrec ListChangeSetsResponse
Int -> ReadS ListChangeSetsResponse
ReadS [ListChangeSetsResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ListChangeSetsResponse]
$creadListPrec :: ReadPrec [ListChangeSetsResponse]
readPrec :: ReadPrec ListChangeSetsResponse
$creadPrec :: ReadPrec ListChangeSetsResponse
readList :: ReadS [ListChangeSetsResponse]
$creadList :: ReadS [ListChangeSetsResponse]
readsPrec :: Int -> ReadS ListChangeSetsResponse
$creadsPrec :: Int -> ReadS ListChangeSetsResponse
Prelude.Read, Int -> ListChangeSetsResponse -> ShowS
[ListChangeSetsResponse] -> ShowS
ListChangeSetsResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ListChangeSetsResponse] -> ShowS
$cshowList :: [ListChangeSetsResponse] -> ShowS
show :: ListChangeSetsResponse -> String
$cshow :: ListChangeSetsResponse -> String
showsPrec :: Int -> ListChangeSetsResponse -> ShowS
$cshowsPrec :: Int -> ListChangeSetsResponse -> ShowS
Prelude.Show, forall x. Rep ListChangeSetsResponse x -> ListChangeSetsResponse
forall x. ListChangeSetsResponse -> Rep ListChangeSetsResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ListChangeSetsResponse x -> ListChangeSetsResponse
$cfrom :: forall x. ListChangeSetsResponse -> Rep ListChangeSetsResponse x
Prelude.Generic)

-- |
-- Create a value of 'ListChangeSetsResponse' 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:
--
-- 'nextToken', 'listChangeSetsResponse_nextToken' - If the output exceeds 1 MB, a string that identifies the next page of
-- change sets. If there is no additional page, this value is @null@.
--
-- 'summaries', 'listChangeSetsResponse_summaries' - A list of @ChangeSetSummary@ structures that provides the ID and status
-- of each change set for the specified stack.
--
-- 'httpStatus', 'listChangeSetsResponse_httpStatus' - The response's http status code.
newListChangeSetsResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  ListChangeSetsResponse
newListChangeSetsResponse :: Int -> ListChangeSetsResponse
newListChangeSetsResponse Int
pHttpStatus_ =
  ListChangeSetsResponse'
    { $sel:nextToken:ListChangeSetsResponse' :: Maybe Text
nextToken =
        forall a. Maybe a
Prelude.Nothing,
      $sel:summaries:ListChangeSetsResponse' :: Maybe [ChangeSetSummary]
summaries = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:ListChangeSetsResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | If the output exceeds 1 MB, a string that identifies the next page of
-- change sets. If there is no additional page, this value is @null@.
listChangeSetsResponse_nextToken :: Lens.Lens' ListChangeSetsResponse (Prelude.Maybe Prelude.Text)
listChangeSetsResponse_nextToken :: Lens' ListChangeSetsResponse (Maybe Text)
listChangeSetsResponse_nextToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListChangeSetsResponse' {Maybe Text
nextToken :: Maybe Text
$sel:nextToken:ListChangeSetsResponse' :: ListChangeSetsResponse -> Maybe Text
nextToken} -> Maybe Text
nextToken) (\s :: ListChangeSetsResponse
s@ListChangeSetsResponse' {} Maybe Text
a -> ListChangeSetsResponse
s {$sel:nextToken:ListChangeSetsResponse' :: Maybe Text
nextToken = Maybe Text
a} :: ListChangeSetsResponse)

-- | A list of @ChangeSetSummary@ structures that provides the ID and status
-- of each change set for the specified stack.
listChangeSetsResponse_summaries :: Lens.Lens' ListChangeSetsResponse (Prelude.Maybe [ChangeSetSummary])
listChangeSetsResponse_summaries :: Lens' ListChangeSetsResponse (Maybe [ChangeSetSummary])
listChangeSetsResponse_summaries = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListChangeSetsResponse' {Maybe [ChangeSetSummary]
summaries :: Maybe [ChangeSetSummary]
$sel:summaries:ListChangeSetsResponse' :: ListChangeSetsResponse -> Maybe [ChangeSetSummary]
summaries} -> Maybe [ChangeSetSummary]
summaries) (\s :: ListChangeSetsResponse
s@ListChangeSetsResponse' {} Maybe [ChangeSetSummary]
a -> ListChangeSetsResponse
s {$sel:summaries:ListChangeSetsResponse' :: Maybe [ChangeSetSummary]
summaries = Maybe [ChangeSetSummary]
a} :: ListChangeSetsResponse) 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.
listChangeSetsResponse_httpStatus :: Lens.Lens' ListChangeSetsResponse Prelude.Int
listChangeSetsResponse_httpStatus :: Lens' ListChangeSetsResponse Int
listChangeSetsResponse_httpStatus = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListChangeSetsResponse' {Int
httpStatus :: Int
$sel:httpStatus:ListChangeSetsResponse' :: ListChangeSetsResponse -> Int
httpStatus} -> Int
httpStatus) (\s :: ListChangeSetsResponse
s@ListChangeSetsResponse' {} Int
a -> ListChangeSetsResponse
s {$sel:httpStatus:ListChangeSetsResponse' :: Int
httpStatus = Int
a} :: ListChangeSetsResponse)

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