{-# 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.Lightsail.GetCloudFormationStackRecords
-- 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 CloudFormation stack record created as a result of the
-- @create cloud formation stack@ operation.
--
-- An AWS CloudFormation stack is used to create a new Amazon EC2 instance
-- from an exported Lightsail snapshot.
--
-- This operation returns paginated results.
module Amazonka.Lightsail.GetCloudFormationStackRecords
  ( -- * Creating a Request
    GetCloudFormationStackRecords (..),
    newGetCloudFormationStackRecords,

    -- * Request Lenses
    getCloudFormationStackRecords_pageToken,

    -- * Destructuring the Response
    GetCloudFormationStackRecordsResponse (..),
    newGetCloudFormationStackRecordsResponse,

    -- * Response Lenses
    getCloudFormationStackRecordsResponse_cloudFormationStackRecords,
    getCloudFormationStackRecordsResponse_nextPageToken,
    getCloudFormationStackRecordsResponse_httpStatus,
  )
where

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

-- | /See:/ 'newGetCloudFormationStackRecords' smart constructor.
data GetCloudFormationStackRecords = GetCloudFormationStackRecords'
  { -- | The token to advance to the next page of results from your request.
    --
    -- To get a page token, perform an initial @GetClouFormationStackRecords@
    -- request. If your results are paginated, the response will return a next
    -- page token that you can specify as the page token in a subsequent
    -- request.
    GetCloudFormationStackRecords -> Maybe Text
pageToken :: Prelude.Maybe Prelude.Text
  }
  deriving (GetCloudFormationStackRecords
-> GetCloudFormationStackRecords -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetCloudFormationStackRecords
-> GetCloudFormationStackRecords -> Bool
$c/= :: GetCloudFormationStackRecords
-> GetCloudFormationStackRecords -> Bool
== :: GetCloudFormationStackRecords
-> GetCloudFormationStackRecords -> Bool
$c== :: GetCloudFormationStackRecords
-> GetCloudFormationStackRecords -> Bool
Prelude.Eq, ReadPrec [GetCloudFormationStackRecords]
ReadPrec GetCloudFormationStackRecords
Int -> ReadS GetCloudFormationStackRecords
ReadS [GetCloudFormationStackRecords]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GetCloudFormationStackRecords]
$creadListPrec :: ReadPrec [GetCloudFormationStackRecords]
readPrec :: ReadPrec GetCloudFormationStackRecords
$creadPrec :: ReadPrec GetCloudFormationStackRecords
readList :: ReadS [GetCloudFormationStackRecords]
$creadList :: ReadS [GetCloudFormationStackRecords]
readsPrec :: Int -> ReadS GetCloudFormationStackRecords
$creadsPrec :: Int -> ReadS GetCloudFormationStackRecords
Prelude.Read, Int -> GetCloudFormationStackRecords -> ShowS
[GetCloudFormationStackRecords] -> ShowS
GetCloudFormationStackRecords -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetCloudFormationStackRecords] -> ShowS
$cshowList :: [GetCloudFormationStackRecords] -> ShowS
show :: GetCloudFormationStackRecords -> String
$cshow :: GetCloudFormationStackRecords -> String
showsPrec :: Int -> GetCloudFormationStackRecords -> ShowS
$cshowsPrec :: Int -> GetCloudFormationStackRecords -> ShowS
Prelude.Show, forall x.
Rep GetCloudFormationStackRecords x
-> GetCloudFormationStackRecords
forall x.
GetCloudFormationStackRecords
-> Rep GetCloudFormationStackRecords x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep GetCloudFormationStackRecords x
-> GetCloudFormationStackRecords
$cfrom :: forall x.
GetCloudFormationStackRecords
-> Rep GetCloudFormationStackRecords x
Prelude.Generic)

-- |
-- Create a value of 'GetCloudFormationStackRecords' 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:
--
-- 'pageToken', 'getCloudFormationStackRecords_pageToken' - The token to advance to the next page of results from your request.
--
-- To get a page token, perform an initial @GetClouFormationStackRecords@
-- request. If your results are paginated, the response will return a next
-- page token that you can specify as the page token in a subsequent
-- request.
newGetCloudFormationStackRecords ::
  GetCloudFormationStackRecords
newGetCloudFormationStackRecords :: GetCloudFormationStackRecords
newGetCloudFormationStackRecords =
  GetCloudFormationStackRecords'
    { $sel:pageToken:GetCloudFormationStackRecords' :: Maybe Text
pageToken =
        forall a. Maybe a
Prelude.Nothing
    }

-- | The token to advance to the next page of results from your request.
--
-- To get a page token, perform an initial @GetClouFormationStackRecords@
-- request. If your results are paginated, the response will return a next
-- page token that you can specify as the page token in a subsequent
-- request.
getCloudFormationStackRecords_pageToken :: Lens.Lens' GetCloudFormationStackRecords (Prelude.Maybe Prelude.Text)
getCloudFormationStackRecords_pageToken :: Lens' GetCloudFormationStackRecords (Maybe Text)
getCloudFormationStackRecords_pageToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetCloudFormationStackRecords' {Maybe Text
pageToken :: Maybe Text
$sel:pageToken:GetCloudFormationStackRecords' :: GetCloudFormationStackRecords -> Maybe Text
pageToken} -> Maybe Text
pageToken) (\s :: GetCloudFormationStackRecords
s@GetCloudFormationStackRecords' {} Maybe Text
a -> GetCloudFormationStackRecords
s {$sel:pageToken:GetCloudFormationStackRecords' :: Maybe Text
pageToken = Maybe Text
a} :: GetCloudFormationStackRecords)

instance Core.AWSPager GetCloudFormationStackRecords where
  page :: GetCloudFormationStackRecords
-> AWSResponse GetCloudFormationStackRecords
-> Maybe GetCloudFormationStackRecords
page GetCloudFormationStackRecords
rq AWSResponse GetCloudFormationStackRecords
rs
    | forall a. AWSTruncated a => a -> Bool
Core.stop
        ( AWSResponse GetCloudFormationStackRecords
rs
            forall s a. s -> Getting (First a) s a -> Maybe a
Lens.^? Lens' GetCloudFormationStackRecordsResponse (Maybe Text)
getCloudFormationStackRecordsResponse_nextPageToken
            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 GetCloudFormationStackRecords
rs
            forall s a. s -> Getting (First a) s a -> Maybe a
Lens.^? Lens'
  GetCloudFormationStackRecordsResponse
  (Maybe [CloudFormationStackRecord])
getCloudFormationStackRecordsResponse_cloudFormationStackRecords
            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.$ GetCloudFormationStackRecords
rq
          forall a b. a -> (a -> b) -> b
Prelude.& Lens' GetCloudFormationStackRecords (Maybe Text)
getCloudFormationStackRecords_pageToken
          forall s t a b. ASetter s t a b -> b -> s -> t
Lens..~ AWSResponse GetCloudFormationStackRecords
rs
          forall s a. s -> Getting (First a) s a -> Maybe a
Lens.^? Lens' GetCloudFormationStackRecordsResponse (Maybe Text)
getCloudFormationStackRecordsResponse_nextPageToken
          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
    GetCloudFormationStackRecords
  where
  type
    AWSResponse GetCloudFormationStackRecords =
      GetCloudFormationStackRecordsResponse
  request :: (Service -> Service)
-> GetCloudFormationStackRecords
-> Request GetCloudFormationStackRecords
request Service -> Service
overrides =
    forall a. (ToRequest a, ToJSON a) => Service -> a -> Request a
Request.postJSON (Service -> Service
overrides Service
defaultService)
  response :: forall (m :: * -> *).
MonadResource m =>
(ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy GetCloudFormationStackRecords
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse GetCloudFormationStackRecords)))
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 [CloudFormationStackRecord]
-> Maybe Text -> Int -> GetCloudFormationStackRecordsResponse
GetCloudFormationStackRecordsResponse'
            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
"cloudFormationStackRecords"
                            forall (f :: * -> *) a. Functor f => f (Maybe a) -> a -> f a
Core..!@ forall a. Monoid a => a
Prelude.mempty
                        )
            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
"nextPageToken")
            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
    GetCloudFormationStackRecords
  where
  hashWithSalt :: Int -> GetCloudFormationStackRecords -> Int
hashWithSalt Int
_salt GetCloudFormationStackRecords' {Maybe Text
pageToken :: Maybe Text
$sel:pageToken:GetCloudFormationStackRecords' :: GetCloudFormationStackRecords -> Maybe Text
..} =
    Int
_salt forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
pageToken

instance Prelude.NFData GetCloudFormationStackRecords where
  rnf :: GetCloudFormationStackRecords -> ()
rnf GetCloudFormationStackRecords' {Maybe Text
pageToken :: Maybe Text
$sel:pageToken:GetCloudFormationStackRecords' :: GetCloudFormationStackRecords -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
pageToken

instance Data.ToHeaders GetCloudFormationStackRecords where
  toHeaders :: GetCloudFormationStackRecords -> ResponseHeaders
toHeaders =
    forall a b. a -> b -> a
Prelude.const
      ( forall a. Monoid a => [a] -> a
Prelude.mconcat
          [ HeaderName
"X-Amz-Target"
              forall a. ToHeader a => HeaderName -> a -> ResponseHeaders
Data.=# ( ByteString
"Lightsail_20161128.GetCloudFormationStackRecords" ::
                          Prelude.ByteString
                      ),
            HeaderName
"Content-Type"
              forall a. ToHeader a => HeaderName -> a -> ResponseHeaders
Data.=# ( ByteString
"application/x-amz-json-1.1" ::
                          Prelude.ByteString
                      )
          ]
      )

instance Data.ToJSON GetCloudFormationStackRecords where
  toJSON :: GetCloudFormationStackRecords -> Value
toJSON GetCloudFormationStackRecords' {Maybe Text
pageToken :: Maybe Text
$sel:pageToken:GetCloudFormationStackRecords' :: GetCloudFormationStackRecords -> Maybe Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [(Key
"pageToken" 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 Text
pageToken]
      )

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

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

-- | /See:/ 'newGetCloudFormationStackRecordsResponse' smart constructor.
data GetCloudFormationStackRecordsResponse = GetCloudFormationStackRecordsResponse'
  { -- | A list of objects describing the CloudFormation stack records.
    GetCloudFormationStackRecordsResponse
-> Maybe [CloudFormationStackRecord]
cloudFormationStackRecords :: Prelude.Maybe [CloudFormationStackRecord],
    -- | The token to advance to the next page of results from your request.
    --
    -- A next page token is not returned if there are no more results to
    -- display.
    --
    -- To get the next page of results, perform another
    -- @GetCloudFormationStackRecords@ request and specify the next page token
    -- using the @pageToken@ parameter.
    GetCloudFormationStackRecordsResponse -> Maybe Text
nextPageToken :: Prelude.Maybe Prelude.Text,
    -- | The response's http status code.
    GetCloudFormationStackRecordsResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (GetCloudFormationStackRecordsResponse
-> GetCloudFormationStackRecordsResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetCloudFormationStackRecordsResponse
-> GetCloudFormationStackRecordsResponse -> Bool
$c/= :: GetCloudFormationStackRecordsResponse
-> GetCloudFormationStackRecordsResponse -> Bool
== :: GetCloudFormationStackRecordsResponse
-> GetCloudFormationStackRecordsResponse -> Bool
$c== :: GetCloudFormationStackRecordsResponse
-> GetCloudFormationStackRecordsResponse -> Bool
Prelude.Eq, ReadPrec [GetCloudFormationStackRecordsResponse]
ReadPrec GetCloudFormationStackRecordsResponse
Int -> ReadS GetCloudFormationStackRecordsResponse
ReadS [GetCloudFormationStackRecordsResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GetCloudFormationStackRecordsResponse]
$creadListPrec :: ReadPrec [GetCloudFormationStackRecordsResponse]
readPrec :: ReadPrec GetCloudFormationStackRecordsResponse
$creadPrec :: ReadPrec GetCloudFormationStackRecordsResponse
readList :: ReadS [GetCloudFormationStackRecordsResponse]
$creadList :: ReadS [GetCloudFormationStackRecordsResponse]
readsPrec :: Int -> ReadS GetCloudFormationStackRecordsResponse
$creadsPrec :: Int -> ReadS GetCloudFormationStackRecordsResponse
Prelude.Read, Int -> GetCloudFormationStackRecordsResponse -> ShowS
[GetCloudFormationStackRecordsResponse] -> ShowS
GetCloudFormationStackRecordsResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetCloudFormationStackRecordsResponse] -> ShowS
$cshowList :: [GetCloudFormationStackRecordsResponse] -> ShowS
show :: GetCloudFormationStackRecordsResponse -> String
$cshow :: GetCloudFormationStackRecordsResponse -> String
showsPrec :: Int -> GetCloudFormationStackRecordsResponse -> ShowS
$cshowsPrec :: Int -> GetCloudFormationStackRecordsResponse -> ShowS
Prelude.Show, forall x.
Rep GetCloudFormationStackRecordsResponse x
-> GetCloudFormationStackRecordsResponse
forall x.
GetCloudFormationStackRecordsResponse
-> Rep GetCloudFormationStackRecordsResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep GetCloudFormationStackRecordsResponse x
-> GetCloudFormationStackRecordsResponse
$cfrom :: forall x.
GetCloudFormationStackRecordsResponse
-> Rep GetCloudFormationStackRecordsResponse x
Prelude.Generic)

-- |
-- Create a value of 'GetCloudFormationStackRecordsResponse' 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:
--
-- 'cloudFormationStackRecords', 'getCloudFormationStackRecordsResponse_cloudFormationStackRecords' - A list of objects describing the CloudFormation stack records.
--
-- 'nextPageToken', 'getCloudFormationStackRecordsResponse_nextPageToken' - The token to advance to the next page of results from your request.
--
-- A next page token is not returned if there are no more results to
-- display.
--
-- To get the next page of results, perform another
-- @GetCloudFormationStackRecords@ request and specify the next page token
-- using the @pageToken@ parameter.
--
-- 'httpStatus', 'getCloudFormationStackRecordsResponse_httpStatus' - The response's http status code.
newGetCloudFormationStackRecordsResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  GetCloudFormationStackRecordsResponse
newGetCloudFormationStackRecordsResponse :: Int -> GetCloudFormationStackRecordsResponse
newGetCloudFormationStackRecordsResponse Int
pHttpStatus_ =
  GetCloudFormationStackRecordsResponse'
    { $sel:cloudFormationStackRecords:GetCloudFormationStackRecordsResponse' :: Maybe [CloudFormationStackRecord]
cloudFormationStackRecords =
        forall a. Maybe a
Prelude.Nothing,
      $sel:nextPageToken:GetCloudFormationStackRecordsResponse' :: Maybe Text
nextPageToken = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:GetCloudFormationStackRecordsResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | A list of objects describing the CloudFormation stack records.
getCloudFormationStackRecordsResponse_cloudFormationStackRecords :: Lens.Lens' GetCloudFormationStackRecordsResponse (Prelude.Maybe [CloudFormationStackRecord])
getCloudFormationStackRecordsResponse_cloudFormationStackRecords :: Lens'
  GetCloudFormationStackRecordsResponse
  (Maybe [CloudFormationStackRecord])
getCloudFormationStackRecordsResponse_cloudFormationStackRecords = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetCloudFormationStackRecordsResponse' {Maybe [CloudFormationStackRecord]
cloudFormationStackRecords :: Maybe [CloudFormationStackRecord]
$sel:cloudFormationStackRecords:GetCloudFormationStackRecordsResponse' :: GetCloudFormationStackRecordsResponse
-> Maybe [CloudFormationStackRecord]
cloudFormationStackRecords} -> Maybe [CloudFormationStackRecord]
cloudFormationStackRecords) (\s :: GetCloudFormationStackRecordsResponse
s@GetCloudFormationStackRecordsResponse' {} Maybe [CloudFormationStackRecord]
a -> GetCloudFormationStackRecordsResponse
s {$sel:cloudFormationStackRecords:GetCloudFormationStackRecordsResponse' :: Maybe [CloudFormationStackRecord]
cloudFormationStackRecords = Maybe [CloudFormationStackRecord]
a} :: GetCloudFormationStackRecordsResponse) 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 token to advance to the next page of results from your request.
--
-- A next page token is not returned if there are no more results to
-- display.
--
-- To get the next page of results, perform another
-- @GetCloudFormationStackRecords@ request and specify the next page token
-- using the @pageToken@ parameter.
getCloudFormationStackRecordsResponse_nextPageToken :: Lens.Lens' GetCloudFormationStackRecordsResponse (Prelude.Maybe Prelude.Text)
getCloudFormationStackRecordsResponse_nextPageToken :: Lens' GetCloudFormationStackRecordsResponse (Maybe Text)
getCloudFormationStackRecordsResponse_nextPageToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetCloudFormationStackRecordsResponse' {Maybe Text
nextPageToken :: Maybe Text
$sel:nextPageToken:GetCloudFormationStackRecordsResponse' :: GetCloudFormationStackRecordsResponse -> Maybe Text
nextPageToken} -> Maybe Text
nextPageToken) (\s :: GetCloudFormationStackRecordsResponse
s@GetCloudFormationStackRecordsResponse' {} Maybe Text
a -> GetCloudFormationStackRecordsResponse
s {$sel:nextPageToken:GetCloudFormationStackRecordsResponse' :: Maybe Text
nextPageToken = Maybe Text
a} :: GetCloudFormationStackRecordsResponse)

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

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