{-# 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.DevOpsGuru.GetResourceCollection
-- 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 lists Amazon Web Services resources that are of the specified
-- resource collection type. The two types of Amazon Web Services resource
-- collections supported are Amazon Web Services CloudFormation stacks and
-- Amazon Web Services resources that contain the same Amazon Web Services
-- tag. DevOps Guru can be configured to analyze the Amazon Web Services
-- resources that are defined in the stacks or that are tagged using the
-- same tag /key/. You can specify up to 500 Amazon Web Services
-- CloudFormation stacks.
--
-- This operation returns paginated results.
module Amazonka.DevOpsGuru.GetResourceCollection
  ( -- * Creating a Request
    GetResourceCollection (..),
    newGetResourceCollection,

    -- * Request Lenses
    getResourceCollection_nextToken,
    getResourceCollection_resourceCollectionType,

    -- * Destructuring the Response
    GetResourceCollectionResponse (..),
    newGetResourceCollectionResponse,

    -- * Response Lenses
    getResourceCollectionResponse_nextToken,
    getResourceCollectionResponse_resourceCollection,
    getResourceCollectionResponse_httpStatus,
  )
where

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

-- | /See:/ 'newGetResourceCollection' smart constructor.
data GetResourceCollection = GetResourceCollection'
  { -- | The pagination token to use to retrieve the next page of results for
    -- this operation. If this value is null, it retrieves the first page.
    GetResourceCollection -> Maybe Text
nextToken :: Prelude.Maybe Prelude.Text,
    -- | The type of Amazon Web Services resource collections to return. The one
    -- valid value is @CLOUD_FORMATION@ for Amazon Web Services CloudFormation
    -- stacks.
    GetResourceCollection -> ResourceCollectionType
resourceCollectionType :: ResourceCollectionType
  }
  deriving (GetResourceCollection -> GetResourceCollection -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetResourceCollection -> GetResourceCollection -> Bool
$c/= :: GetResourceCollection -> GetResourceCollection -> Bool
== :: GetResourceCollection -> GetResourceCollection -> Bool
$c== :: GetResourceCollection -> GetResourceCollection -> Bool
Prelude.Eq, ReadPrec [GetResourceCollection]
ReadPrec GetResourceCollection
Int -> ReadS GetResourceCollection
ReadS [GetResourceCollection]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GetResourceCollection]
$creadListPrec :: ReadPrec [GetResourceCollection]
readPrec :: ReadPrec GetResourceCollection
$creadPrec :: ReadPrec GetResourceCollection
readList :: ReadS [GetResourceCollection]
$creadList :: ReadS [GetResourceCollection]
readsPrec :: Int -> ReadS GetResourceCollection
$creadsPrec :: Int -> ReadS GetResourceCollection
Prelude.Read, Int -> GetResourceCollection -> ShowS
[GetResourceCollection] -> ShowS
GetResourceCollection -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetResourceCollection] -> ShowS
$cshowList :: [GetResourceCollection] -> ShowS
show :: GetResourceCollection -> String
$cshow :: GetResourceCollection -> String
showsPrec :: Int -> GetResourceCollection -> ShowS
$cshowsPrec :: Int -> GetResourceCollection -> ShowS
Prelude.Show, forall x. Rep GetResourceCollection x -> GetResourceCollection
forall x. GetResourceCollection -> Rep GetResourceCollection x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep GetResourceCollection x -> GetResourceCollection
$cfrom :: forall x. GetResourceCollection -> Rep GetResourceCollection x
Prelude.Generic)

-- |
-- Create a value of 'GetResourceCollection' 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', 'getResourceCollection_nextToken' - The pagination token to use to retrieve the next page of results for
-- this operation. If this value is null, it retrieves the first page.
--
-- 'resourceCollectionType', 'getResourceCollection_resourceCollectionType' - The type of Amazon Web Services resource collections to return. The one
-- valid value is @CLOUD_FORMATION@ for Amazon Web Services CloudFormation
-- stacks.
newGetResourceCollection ::
  -- | 'resourceCollectionType'
  ResourceCollectionType ->
  GetResourceCollection
newGetResourceCollection :: ResourceCollectionType -> GetResourceCollection
newGetResourceCollection ResourceCollectionType
pResourceCollectionType_ =
  GetResourceCollection'
    { $sel:nextToken:GetResourceCollection' :: Maybe Text
nextToken = forall a. Maybe a
Prelude.Nothing,
      $sel:resourceCollectionType:GetResourceCollection' :: ResourceCollectionType
resourceCollectionType = ResourceCollectionType
pResourceCollectionType_
    }

-- | The pagination token to use to retrieve the next page of results for
-- this operation. If this value is null, it retrieves the first page.
getResourceCollection_nextToken :: Lens.Lens' GetResourceCollection (Prelude.Maybe Prelude.Text)
getResourceCollection_nextToken :: Lens' GetResourceCollection (Maybe Text)
getResourceCollection_nextToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetResourceCollection' {Maybe Text
nextToken :: Maybe Text
$sel:nextToken:GetResourceCollection' :: GetResourceCollection -> Maybe Text
nextToken} -> Maybe Text
nextToken) (\s :: GetResourceCollection
s@GetResourceCollection' {} Maybe Text
a -> GetResourceCollection
s {$sel:nextToken:GetResourceCollection' :: Maybe Text
nextToken = Maybe Text
a} :: GetResourceCollection)

-- | The type of Amazon Web Services resource collections to return. The one
-- valid value is @CLOUD_FORMATION@ for Amazon Web Services CloudFormation
-- stacks.
getResourceCollection_resourceCollectionType :: Lens.Lens' GetResourceCollection ResourceCollectionType
getResourceCollection_resourceCollectionType :: Lens' GetResourceCollection ResourceCollectionType
getResourceCollection_resourceCollectionType = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetResourceCollection' {ResourceCollectionType
resourceCollectionType :: ResourceCollectionType
$sel:resourceCollectionType:GetResourceCollection' :: GetResourceCollection -> ResourceCollectionType
resourceCollectionType} -> ResourceCollectionType
resourceCollectionType) (\s :: GetResourceCollection
s@GetResourceCollection' {} ResourceCollectionType
a -> GetResourceCollection
s {$sel:resourceCollectionType:GetResourceCollection' :: ResourceCollectionType
resourceCollectionType = ResourceCollectionType
a} :: GetResourceCollection)

instance Core.AWSPager GetResourceCollection where
  page :: GetResourceCollection
-> AWSResponse GetResourceCollection -> Maybe GetResourceCollection
page GetResourceCollection
rq AWSResponse GetResourceCollection
rs
    | forall a. AWSTruncated a => a -> Bool
Core.stop
        ( AWSResponse GetResourceCollection
rs
            forall s a. s -> Getting (First a) s a -> Maybe a
Lens.^? Lens' GetResourceCollectionResponse (Maybe Text)
getResourceCollectionResponse_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 GetResourceCollection
rs
            forall s a. s -> Getting (First a) s a -> Maybe a
Lens.^? Lens'
  GetResourceCollectionResponse (Maybe ResourceCollectionFilter)
getResourceCollectionResponse_resourceCollection
            forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall a b. Prism (Maybe a) (Maybe b) a b
Lens._Just
            forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. Lens'
  ResourceCollectionFilter (Maybe CloudFormationCollectionFilter)
resourceCollectionFilter_cloudFormation
            forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall a b. Prism (Maybe a) (Maybe b) a b
Lens._Just
            forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. Lens' CloudFormationCollectionFilter (Maybe [Text])
cloudFormationCollectionFilter_stackNames
            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 GetResourceCollection
rs
            forall s a. s -> Getting (First a) s a -> Maybe a
Lens.^? Lens'
  GetResourceCollectionResponse (Maybe ResourceCollectionFilter)
getResourceCollectionResponse_resourceCollection
            forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall a b. Prism (Maybe a) (Maybe b) a b
Lens._Just
            forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. Lens' ResourceCollectionFilter (Maybe [TagCollectionFilter])
resourceCollectionFilter_tags
            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.$ GetResourceCollection
rq
          forall a b. a -> (a -> b) -> b
Prelude.& Lens' GetResourceCollection (Maybe Text)
getResourceCollection_nextToken
          forall s t a b. ASetter s t a b -> b -> s -> t
Lens..~ AWSResponse GetResourceCollection
rs
          forall s a. s -> Getting (First a) s a -> Maybe a
Lens.^? Lens' GetResourceCollectionResponse (Maybe Text)
getResourceCollectionResponse_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 GetResourceCollection where
  type
    AWSResponse GetResourceCollection =
      GetResourceCollectionResponse
  request :: (Service -> Service)
-> GetResourceCollection -> Request GetResourceCollection
request Service -> Service
overrides =
    forall a. ToRequest a => Service -> a -> Request a
Request.get (Service -> Service
overrides Service
defaultService)
  response :: forall (m :: * -> *).
MonadResource m =>
(ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy GetResourceCollection
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse GetResourceCollection)))
response =
    forall (m :: * -> *) a.
MonadResource m =>
(Int -> ResponseHeaders -> Object -> Either String (AWSResponse a))
-> (ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy a
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse a)))
Response.receiveJSON
      ( \Int
s ResponseHeaders
h Object
x ->
          Maybe Text
-> Maybe ResourceCollectionFilter
-> Int
-> GetResourceCollectionResponse
GetResourceCollectionResponse'
            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
"NextToken")
            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
"ResourceCollection")
            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 GetResourceCollection where
  hashWithSalt :: Int -> GetResourceCollection -> Int
hashWithSalt Int
_salt GetResourceCollection' {Maybe Text
ResourceCollectionType
resourceCollectionType :: ResourceCollectionType
nextToken :: Maybe Text
$sel:resourceCollectionType:GetResourceCollection' :: GetResourceCollection -> ResourceCollectionType
$sel:nextToken:GetResourceCollection' :: GetResourceCollection -> 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` ResourceCollectionType
resourceCollectionType

instance Prelude.NFData GetResourceCollection where
  rnf :: GetResourceCollection -> ()
rnf GetResourceCollection' {Maybe Text
ResourceCollectionType
resourceCollectionType :: ResourceCollectionType
nextToken :: Maybe Text
$sel:resourceCollectionType:GetResourceCollection' :: GetResourceCollection -> ResourceCollectionType
$sel:nextToken:GetResourceCollection' :: GetResourceCollection -> 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 ResourceCollectionType
resourceCollectionType

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

instance Data.ToPath GetResourceCollection where
  toPath :: GetResourceCollection -> ByteString
toPath GetResourceCollection' {Maybe Text
ResourceCollectionType
resourceCollectionType :: ResourceCollectionType
nextToken :: Maybe Text
$sel:resourceCollectionType:GetResourceCollection' :: GetResourceCollection -> ResourceCollectionType
$sel:nextToken:GetResourceCollection' :: GetResourceCollection -> Maybe Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"/resource-collections/",
        forall a. ToByteString a => a -> ByteString
Data.toBS ResourceCollectionType
resourceCollectionType
      ]

instance Data.ToQuery GetResourceCollection where
  toQuery :: GetResourceCollection -> QueryString
toQuery GetResourceCollection' {Maybe Text
ResourceCollectionType
resourceCollectionType :: ResourceCollectionType
nextToken :: Maybe Text
$sel:resourceCollectionType:GetResourceCollection' :: GetResourceCollection -> ResourceCollectionType
$sel:nextToken:GetResourceCollection' :: GetResourceCollection -> Maybe Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat [ByteString
"NextToken" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Text
nextToken]

-- | /See:/ 'newGetResourceCollectionResponse' smart constructor.
data GetResourceCollectionResponse = GetResourceCollectionResponse'
  { -- | The pagination token to use to retrieve the next page of results for
    -- this operation. If there are no more pages, this value is null.
    GetResourceCollectionResponse -> Maybe Text
nextToken :: Prelude.Maybe Prelude.Text,
    -- | The requested list of Amazon Web Services resource collections. The two
    -- types of Amazon Web Services resource collections supported are Amazon
    -- Web Services CloudFormation stacks and Amazon Web Services resources
    -- that contain the same Amazon Web Services tag. DevOps Guru can be
    -- configured to analyze the Amazon Web Services resources that are defined
    -- in the stacks or that are tagged using the same tag /key/. You can
    -- specify up to 500 Amazon Web Services CloudFormation stacks.
    GetResourceCollectionResponse -> Maybe ResourceCollectionFilter
resourceCollection :: Prelude.Maybe ResourceCollectionFilter,
    -- | The response's http status code.
    GetResourceCollectionResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (GetResourceCollectionResponse
-> GetResourceCollectionResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetResourceCollectionResponse
-> GetResourceCollectionResponse -> Bool
$c/= :: GetResourceCollectionResponse
-> GetResourceCollectionResponse -> Bool
== :: GetResourceCollectionResponse
-> GetResourceCollectionResponse -> Bool
$c== :: GetResourceCollectionResponse
-> GetResourceCollectionResponse -> Bool
Prelude.Eq, ReadPrec [GetResourceCollectionResponse]
ReadPrec GetResourceCollectionResponse
Int -> ReadS GetResourceCollectionResponse
ReadS [GetResourceCollectionResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GetResourceCollectionResponse]
$creadListPrec :: ReadPrec [GetResourceCollectionResponse]
readPrec :: ReadPrec GetResourceCollectionResponse
$creadPrec :: ReadPrec GetResourceCollectionResponse
readList :: ReadS [GetResourceCollectionResponse]
$creadList :: ReadS [GetResourceCollectionResponse]
readsPrec :: Int -> ReadS GetResourceCollectionResponse
$creadsPrec :: Int -> ReadS GetResourceCollectionResponse
Prelude.Read, Int -> GetResourceCollectionResponse -> ShowS
[GetResourceCollectionResponse] -> ShowS
GetResourceCollectionResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetResourceCollectionResponse] -> ShowS
$cshowList :: [GetResourceCollectionResponse] -> ShowS
show :: GetResourceCollectionResponse -> String
$cshow :: GetResourceCollectionResponse -> String
showsPrec :: Int -> GetResourceCollectionResponse -> ShowS
$cshowsPrec :: Int -> GetResourceCollectionResponse -> ShowS
Prelude.Show, forall x.
Rep GetResourceCollectionResponse x
-> GetResourceCollectionResponse
forall x.
GetResourceCollectionResponse
-> Rep GetResourceCollectionResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep GetResourceCollectionResponse x
-> GetResourceCollectionResponse
$cfrom :: forall x.
GetResourceCollectionResponse
-> Rep GetResourceCollectionResponse x
Prelude.Generic)

-- |
-- Create a value of 'GetResourceCollectionResponse' 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', 'getResourceCollectionResponse_nextToken' - The pagination token to use to retrieve the next page of results for
-- this operation. If there are no more pages, this value is null.
--
-- 'resourceCollection', 'getResourceCollectionResponse_resourceCollection' - The requested list of Amazon Web Services resource collections. The two
-- types of Amazon Web Services resource collections supported are Amazon
-- Web Services CloudFormation stacks and Amazon Web Services resources
-- that contain the same Amazon Web Services tag. DevOps Guru can be
-- configured to analyze the Amazon Web Services resources that are defined
-- in the stacks or that are tagged using the same tag /key/. You can
-- specify up to 500 Amazon Web Services CloudFormation stacks.
--
-- 'httpStatus', 'getResourceCollectionResponse_httpStatus' - The response's http status code.
newGetResourceCollectionResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  GetResourceCollectionResponse
newGetResourceCollectionResponse :: Int -> GetResourceCollectionResponse
newGetResourceCollectionResponse Int
pHttpStatus_ =
  GetResourceCollectionResponse'
    { $sel:nextToken:GetResourceCollectionResponse' :: Maybe Text
nextToken =
        forall a. Maybe a
Prelude.Nothing,
      $sel:resourceCollection:GetResourceCollectionResponse' :: Maybe ResourceCollectionFilter
resourceCollection = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:GetResourceCollectionResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | The pagination token to use to retrieve the next page of results for
-- this operation. If there are no more pages, this value is null.
getResourceCollectionResponse_nextToken :: Lens.Lens' GetResourceCollectionResponse (Prelude.Maybe Prelude.Text)
getResourceCollectionResponse_nextToken :: Lens' GetResourceCollectionResponse (Maybe Text)
getResourceCollectionResponse_nextToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetResourceCollectionResponse' {Maybe Text
nextToken :: Maybe Text
$sel:nextToken:GetResourceCollectionResponse' :: GetResourceCollectionResponse -> Maybe Text
nextToken} -> Maybe Text
nextToken) (\s :: GetResourceCollectionResponse
s@GetResourceCollectionResponse' {} Maybe Text
a -> GetResourceCollectionResponse
s {$sel:nextToken:GetResourceCollectionResponse' :: Maybe Text
nextToken = Maybe Text
a} :: GetResourceCollectionResponse)

-- | The requested list of Amazon Web Services resource collections. The two
-- types of Amazon Web Services resource collections supported are Amazon
-- Web Services CloudFormation stacks and Amazon Web Services resources
-- that contain the same Amazon Web Services tag. DevOps Guru can be
-- configured to analyze the Amazon Web Services resources that are defined
-- in the stacks or that are tagged using the same tag /key/. You can
-- specify up to 500 Amazon Web Services CloudFormation stacks.
getResourceCollectionResponse_resourceCollection :: Lens.Lens' GetResourceCollectionResponse (Prelude.Maybe ResourceCollectionFilter)
getResourceCollectionResponse_resourceCollection :: Lens'
  GetResourceCollectionResponse (Maybe ResourceCollectionFilter)
getResourceCollectionResponse_resourceCollection = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetResourceCollectionResponse' {Maybe ResourceCollectionFilter
resourceCollection :: Maybe ResourceCollectionFilter
$sel:resourceCollection:GetResourceCollectionResponse' :: GetResourceCollectionResponse -> Maybe ResourceCollectionFilter
resourceCollection} -> Maybe ResourceCollectionFilter
resourceCollection) (\s :: GetResourceCollectionResponse
s@GetResourceCollectionResponse' {} Maybe ResourceCollectionFilter
a -> GetResourceCollectionResponse
s {$sel:resourceCollection:GetResourceCollectionResponse' :: Maybe ResourceCollectionFilter
resourceCollection = Maybe ResourceCollectionFilter
a} :: GetResourceCollectionResponse)

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

instance Prelude.NFData GetResourceCollectionResponse where
  rnf :: GetResourceCollectionResponse -> ()
rnf GetResourceCollectionResponse' {Int
Maybe Text
Maybe ResourceCollectionFilter
httpStatus :: Int
resourceCollection :: Maybe ResourceCollectionFilter
nextToken :: Maybe Text
$sel:httpStatus:GetResourceCollectionResponse' :: GetResourceCollectionResponse -> Int
$sel:resourceCollection:GetResourceCollectionResponse' :: GetResourceCollectionResponse -> Maybe ResourceCollectionFilter
$sel:nextToken:GetResourceCollectionResponse' :: GetResourceCollectionResponse -> 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 ResourceCollectionFilter
resourceCollection
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus