{-# 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.ResourceExplorer2.ListSupportedResourceTypes
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Retrieves a list of all resource types currently supported by Amazon Web
-- Services Resource Explorer.
--
-- This operation returns paginated results.
module Amazonka.ResourceExplorer2.ListSupportedResourceTypes
  ( -- * Creating a Request
    ListSupportedResourceTypes (..),
    newListSupportedResourceTypes,

    -- * Request Lenses
    listSupportedResourceTypes_maxResults,
    listSupportedResourceTypes_nextToken,

    -- * Destructuring the Response
    ListSupportedResourceTypesResponse (..),
    newListSupportedResourceTypesResponse,

    -- * Response Lenses
    listSupportedResourceTypesResponse_nextToken,
    listSupportedResourceTypesResponse_resourceTypes,
    listSupportedResourceTypesResponse_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 qualified Amazonka.Request as Request
import Amazonka.ResourceExplorer2.Types
import qualified Amazonka.Response as Response

-- | /See:/ 'newListSupportedResourceTypes' smart constructor.
data ListSupportedResourceTypes = ListSupportedResourceTypes'
  { -- | The maximum number of results that you want included on each page of the
    -- response. If you do not include this parameter, it defaults to a value
    -- appropriate to the operation. If additional items exist beyond those
    -- included in the current response, the @NextToken@ response element is
    -- present and has a value (is not null). Include that value as the
    -- @NextToken@ request parameter in the next call to the operation to get
    -- the next part of the results.
    --
    -- An API operation can return fewer results than the maximum even when
    -- there are more results available. You should check @NextToken@ after
    -- every operation to ensure that you receive all of the results.
    ListSupportedResourceTypes -> Maybe Natural
maxResults :: Prelude.Maybe Prelude.Natural,
    -- | The parameter for receiving additional results if you receive a
    -- @NextToken@ response in a previous request. A @NextToken@ response
    -- indicates that more output is available. Set this parameter to the value
    -- of the previous call\'s @NextToken@ response to indicate where the
    -- output should continue from.
    ListSupportedResourceTypes -> Maybe Text
nextToken :: Prelude.Maybe Prelude.Text
  }
  deriving (ListSupportedResourceTypes -> ListSupportedResourceTypes -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ListSupportedResourceTypes -> ListSupportedResourceTypes -> Bool
$c/= :: ListSupportedResourceTypes -> ListSupportedResourceTypes -> Bool
== :: ListSupportedResourceTypes -> ListSupportedResourceTypes -> Bool
$c== :: ListSupportedResourceTypes -> ListSupportedResourceTypes -> Bool
Prelude.Eq, ReadPrec [ListSupportedResourceTypes]
ReadPrec ListSupportedResourceTypes
Int -> ReadS ListSupportedResourceTypes
ReadS [ListSupportedResourceTypes]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ListSupportedResourceTypes]
$creadListPrec :: ReadPrec [ListSupportedResourceTypes]
readPrec :: ReadPrec ListSupportedResourceTypes
$creadPrec :: ReadPrec ListSupportedResourceTypes
readList :: ReadS [ListSupportedResourceTypes]
$creadList :: ReadS [ListSupportedResourceTypes]
readsPrec :: Int -> ReadS ListSupportedResourceTypes
$creadsPrec :: Int -> ReadS ListSupportedResourceTypes
Prelude.Read, Int -> ListSupportedResourceTypes -> ShowS
[ListSupportedResourceTypes] -> ShowS
ListSupportedResourceTypes -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ListSupportedResourceTypes] -> ShowS
$cshowList :: [ListSupportedResourceTypes] -> ShowS
show :: ListSupportedResourceTypes -> String
$cshow :: ListSupportedResourceTypes -> String
showsPrec :: Int -> ListSupportedResourceTypes -> ShowS
$cshowsPrec :: Int -> ListSupportedResourceTypes -> ShowS
Prelude.Show, forall x.
Rep ListSupportedResourceTypes x -> ListSupportedResourceTypes
forall x.
ListSupportedResourceTypes -> Rep ListSupportedResourceTypes x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep ListSupportedResourceTypes x -> ListSupportedResourceTypes
$cfrom :: forall x.
ListSupportedResourceTypes -> Rep ListSupportedResourceTypes x
Prelude.Generic)

-- |
-- Create a value of 'ListSupportedResourceTypes' 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:
--
-- 'maxResults', 'listSupportedResourceTypes_maxResults' - The maximum number of results that you want included on each page of the
-- response. If you do not include this parameter, it defaults to a value
-- appropriate to the operation. If additional items exist beyond those
-- included in the current response, the @NextToken@ response element is
-- present and has a value (is not null). Include that value as the
-- @NextToken@ request parameter in the next call to the operation to get
-- the next part of the results.
--
-- An API operation can return fewer results than the maximum even when
-- there are more results available. You should check @NextToken@ after
-- every operation to ensure that you receive all of the results.
--
-- 'nextToken', 'listSupportedResourceTypes_nextToken' - The parameter for receiving additional results if you receive a
-- @NextToken@ response in a previous request. A @NextToken@ response
-- indicates that more output is available. Set this parameter to the value
-- of the previous call\'s @NextToken@ response to indicate where the
-- output should continue from.
newListSupportedResourceTypes ::
  ListSupportedResourceTypes
newListSupportedResourceTypes :: ListSupportedResourceTypes
newListSupportedResourceTypes =
  ListSupportedResourceTypes'
    { $sel:maxResults:ListSupportedResourceTypes' :: Maybe Natural
maxResults =
        forall a. Maybe a
Prelude.Nothing,
      $sel:nextToken:ListSupportedResourceTypes' :: Maybe Text
nextToken = forall a. Maybe a
Prelude.Nothing
    }

-- | The maximum number of results that you want included on each page of the
-- response. If you do not include this parameter, it defaults to a value
-- appropriate to the operation. If additional items exist beyond those
-- included in the current response, the @NextToken@ response element is
-- present and has a value (is not null). Include that value as the
-- @NextToken@ request parameter in the next call to the operation to get
-- the next part of the results.
--
-- An API operation can return fewer results than the maximum even when
-- there are more results available. You should check @NextToken@ after
-- every operation to ensure that you receive all of the results.
listSupportedResourceTypes_maxResults :: Lens.Lens' ListSupportedResourceTypes (Prelude.Maybe Prelude.Natural)
listSupportedResourceTypes_maxResults :: Lens' ListSupportedResourceTypes (Maybe Natural)
listSupportedResourceTypes_maxResults = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListSupportedResourceTypes' {Maybe Natural
maxResults :: Maybe Natural
$sel:maxResults:ListSupportedResourceTypes' :: ListSupportedResourceTypes -> Maybe Natural
maxResults} -> Maybe Natural
maxResults) (\s :: ListSupportedResourceTypes
s@ListSupportedResourceTypes' {} Maybe Natural
a -> ListSupportedResourceTypes
s {$sel:maxResults:ListSupportedResourceTypes' :: Maybe Natural
maxResults = Maybe Natural
a} :: ListSupportedResourceTypes)

-- | The parameter for receiving additional results if you receive a
-- @NextToken@ response in a previous request. A @NextToken@ response
-- indicates that more output is available. Set this parameter to the value
-- of the previous call\'s @NextToken@ response to indicate where the
-- output should continue from.
listSupportedResourceTypes_nextToken :: Lens.Lens' ListSupportedResourceTypes (Prelude.Maybe Prelude.Text)
listSupportedResourceTypes_nextToken :: Lens' ListSupportedResourceTypes (Maybe Text)
listSupportedResourceTypes_nextToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListSupportedResourceTypes' {Maybe Text
nextToken :: Maybe Text
$sel:nextToken:ListSupportedResourceTypes' :: ListSupportedResourceTypes -> Maybe Text
nextToken} -> Maybe Text
nextToken) (\s :: ListSupportedResourceTypes
s@ListSupportedResourceTypes' {} Maybe Text
a -> ListSupportedResourceTypes
s {$sel:nextToken:ListSupportedResourceTypes' :: Maybe Text
nextToken = Maybe Text
a} :: ListSupportedResourceTypes)

instance Core.AWSPager ListSupportedResourceTypes where
  page :: ListSupportedResourceTypes
-> AWSResponse ListSupportedResourceTypes
-> Maybe ListSupportedResourceTypes
page ListSupportedResourceTypes
rq AWSResponse ListSupportedResourceTypes
rs
    | forall a. AWSTruncated a => a -> Bool
Core.stop
        ( AWSResponse ListSupportedResourceTypes
rs
            forall s a. s -> Getting (First a) s a -> Maybe a
Lens.^? Lens' ListSupportedResourceTypesResponse (Maybe Text)
listSupportedResourceTypesResponse_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 ListSupportedResourceTypes
rs
            forall s a. s -> Getting (First a) s a -> Maybe a
Lens.^? Lens'
  ListSupportedResourceTypesResponse (Maybe [SupportedResourceType])
listSupportedResourceTypesResponse_resourceTypes
            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.$ ListSupportedResourceTypes
rq
          forall a b. a -> (a -> b) -> b
Prelude.& Lens' ListSupportedResourceTypes (Maybe Text)
listSupportedResourceTypes_nextToken
          forall s t a b. ASetter s t a b -> b -> s -> t
Lens..~ AWSResponse ListSupportedResourceTypes
rs
          forall s a. s -> Getting (First a) s a -> Maybe a
Lens.^? Lens' ListSupportedResourceTypesResponse (Maybe Text)
listSupportedResourceTypesResponse_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 ListSupportedResourceTypes where
  type
    AWSResponse ListSupportedResourceTypes =
      ListSupportedResourceTypesResponse
  request :: (Service -> Service)
-> ListSupportedResourceTypes -> Request ListSupportedResourceTypes
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 ListSupportedResourceTypes
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse ListSupportedResourceTypes)))
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 [SupportedResourceType]
-> Int
-> ListSupportedResourceTypesResponse
ListSupportedResourceTypesResponse'
            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
"ResourceTypes" 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.<*> (forall (f :: * -> *) a. Applicative f => a -> f a
Prelude.pure (forall a. Enum a => a -> Int
Prelude.fromEnum Int
s))
      )

instance Prelude.Hashable ListSupportedResourceTypes where
  hashWithSalt :: Int -> ListSupportedResourceTypes -> Int
hashWithSalt Int
_salt ListSupportedResourceTypes' {Maybe Natural
Maybe Text
nextToken :: Maybe Text
maxResults :: Maybe Natural
$sel:nextToken:ListSupportedResourceTypes' :: ListSupportedResourceTypes -> Maybe Text
$sel:maxResults:ListSupportedResourceTypes' :: ListSupportedResourceTypes -> Maybe Natural
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Natural
maxResults
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
nextToken

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

instance Data.ToHeaders ListSupportedResourceTypes where
  toHeaders :: ListSupportedResourceTypes -> 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.ToJSON ListSupportedResourceTypes where
  toJSON :: ListSupportedResourceTypes -> Value
toJSON ListSupportedResourceTypes' {Maybe Natural
Maybe Text
nextToken :: Maybe Text
maxResults :: Maybe Natural
$sel:nextToken:ListSupportedResourceTypes' :: ListSupportedResourceTypes -> Maybe Text
$sel:maxResults:ListSupportedResourceTypes' :: ListSupportedResourceTypes -> Maybe Natural
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"MaxResults" 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 Natural
maxResults,
            (Key
"NextToken" 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
nextToken
          ]
      )

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

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

-- | /See:/ 'newListSupportedResourceTypesResponse' smart constructor.
data ListSupportedResourceTypesResponse = ListSupportedResourceTypesResponse'
  { -- | If present, indicates that more output is available than is included in
    -- the current response. Use this value in the @NextToken@ request
    -- parameter in a subsequent call to the operation to get the next part of
    -- the output. You should repeat this until the @NextToken@ response
    -- element comes back as @null@.
    ListSupportedResourceTypesResponse -> Maybe Text
nextToken :: Prelude.Maybe Prelude.Text,
    -- | The list of resource types supported by Resource Explorer.
    ListSupportedResourceTypesResponse -> Maybe [SupportedResourceType]
resourceTypes :: Prelude.Maybe [SupportedResourceType],
    -- | The response's http status code.
    ListSupportedResourceTypesResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (ListSupportedResourceTypesResponse
-> ListSupportedResourceTypesResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ListSupportedResourceTypesResponse
-> ListSupportedResourceTypesResponse -> Bool
$c/= :: ListSupportedResourceTypesResponse
-> ListSupportedResourceTypesResponse -> Bool
== :: ListSupportedResourceTypesResponse
-> ListSupportedResourceTypesResponse -> Bool
$c== :: ListSupportedResourceTypesResponse
-> ListSupportedResourceTypesResponse -> Bool
Prelude.Eq, ReadPrec [ListSupportedResourceTypesResponse]
ReadPrec ListSupportedResourceTypesResponse
Int -> ReadS ListSupportedResourceTypesResponse
ReadS [ListSupportedResourceTypesResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ListSupportedResourceTypesResponse]
$creadListPrec :: ReadPrec [ListSupportedResourceTypesResponse]
readPrec :: ReadPrec ListSupportedResourceTypesResponse
$creadPrec :: ReadPrec ListSupportedResourceTypesResponse
readList :: ReadS [ListSupportedResourceTypesResponse]
$creadList :: ReadS [ListSupportedResourceTypesResponse]
readsPrec :: Int -> ReadS ListSupportedResourceTypesResponse
$creadsPrec :: Int -> ReadS ListSupportedResourceTypesResponse
Prelude.Read, Int -> ListSupportedResourceTypesResponse -> ShowS
[ListSupportedResourceTypesResponse] -> ShowS
ListSupportedResourceTypesResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ListSupportedResourceTypesResponse] -> ShowS
$cshowList :: [ListSupportedResourceTypesResponse] -> ShowS
show :: ListSupportedResourceTypesResponse -> String
$cshow :: ListSupportedResourceTypesResponse -> String
showsPrec :: Int -> ListSupportedResourceTypesResponse -> ShowS
$cshowsPrec :: Int -> ListSupportedResourceTypesResponse -> ShowS
Prelude.Show, forall x.
Rep ListSupportedResourceTypesResponse x
-> ListSupportedResourceTypesResponse
forall x.
ListSupportedResourceTypesResponse
-> Rep ListSupportedResourceTypesResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep ListSupportedResourceTypesResponse x
-> ListSupportedResourceTypesResponse
$cfrom :: forall x.
ListSupportedResourceTypesResponse
-> Rep ListSupportedResourceTypesResponse x
Prelude.Generic)

-- |
-- Create a value of 'ListSupportedResourceTypesResponse' 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', 'listSupportedResourceTypesResponse_nextToken' - If present, indicates that more output is available than is included in
-- the current response. Use this value in the @NextToken@ request
-- parameter in a subsequent call to the operation to get the next part of
-- the output. You should repeat this until the @NextToken@ response
-- element comes back as @null@.
--
-- 'resourceTypes', 'listSupportedResourceTypesResponse_resourceTypes' - The list of resource types supported by Resource Explorer.
--
-- 'httpStatus', 'listSupportedResourceTypesResponse_httpStatus' - The response's http status code.
newListSupportedResourceTypesResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  ListSupportedResourceTypesResponse
newListSupportedResourceTypesResponse :: Int -> ListSupportedResourceTypesResponse
newListSupportedResourceTypesResponse Int
pHttpStatus_ =
  ListSupportedResourceTypesResponse'
    { $sel:nextToken:ListSupportedResourceTypesResponse' :: Maybe Text
nextToken =
        forall a. Maybe a
Prelude.Nothing,
      $sel:resourceTypes:ListSupportedResourceTypesResponse' :: Maybe [SupportedResourceType]
resourceTypes = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:ListSupportedResourceTypesResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | If present, indicates that more output is available than is included in
-- the current response. Use this value in the @NextToken@ request
-- parameter in a subsequent call to the operation to get the next part of
-- the output. You should repeat this until the @NextToken@ response
-- element comes back as @null@.
listSupportedResourceTypesResponse_nextToken :: Lens.Lens' ListSupportedResourceTypesResponse (Prelude.Maybe Prelude.Text)
listSupportedResourceTypesResponse_nextToken :: Lens' ListSupportedResourceTypesResponse (Maybe Text)
listSupportedResourceTypesResponse_nextToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListSupportedResourceTypesResponse' {Maybe Text
nextToken :: Maybe Text
$sel:nextToken:ListSupportedResourceTypesResponse' :: ListSupportedResourceTypesResponse -> Maybe Text
nextToken} -> Maybe Text
nextToken) (\s :: ListSupportedResourceTypesResponse
s@ListSupportedResourceTypesResponse' {} Maybe Text
a -> ListSupportedResourceTypesResponse
s {$sel:nextToken:ListSupportedResourceTypesResponse' :: Maybe Text
nextToken = Maybe Text
a} :: ListSupportedResourceTypesResponse)

-- | The list of resource types supported by Resource Explorer.
listSupportedResourceTypesResponse_resourceTypes :: Lens.Lens' ListSupportedResourceTypesResponse (Prelude.Maybe [SupportedResourceType])
listSupportedResourceTypesResponse_resourceTypes :: Lens'
  ListSupportedResourceTypesResponse (Maybe [SupportedResourceType])
listSupportedResourceTypesResponse_resourceTypes = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListSupportedResourceTypesResponse' {Maybe [SupportedResourceType]
resourceTypes :: Maybe [SupportedResourceType]
$sel:resourceTypes:ListSupportedResourceTypesResponse' :: ListSupportedResourceTypesResponse -> Maybe [SupportedResourceType]
resourceTypes} -> Maybe [SupportedResourceType]
resourceTypes) (\s :: ListSupportedResourceTypesResponse
s@ListSupportedResourceTypesResponse' {} Maybe [SupportedResourceType]
a -> ListSupportedResourceTypesResponse
s {$sel:resourceTypes:ListSupportedResourceTypesResponse' :: Maybe [SupportedResourceType]
resourceTypes = Maybe [SupportedResourceType]
a} :: ListSupportedResourceTypesResponse) 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.
listSupportedResourceTypesResponse_httpStatus :: Lens.Lens' ListSupportedResourceTypesResponse Prelude.Int
listSupportedResourceTypesResponse_httpStatus :: Lens' ListSupportedResourceTypesResponse Int
listSupportedResourceTypesResponse_httpStatus = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListSupportedResourceTypesResponse' {Int
httpStatus :: Int
$sel:httpStatus:ListSupportedResourceTypesResponse' :: ListSupportedResourceTypesResponse -> Int
httpStatus} -> Int
httpStatus) (\s :: ListSupportedResourceTypesResponse
s@ListSupportedResourceTypesResponse' {} Int
a -> ListSupportedResourceTypesResponse
s {$sel:httpStatus:ListSupportedResourceTypesResponse' :: Int
httpStatus = Int
a} :: ListSupportedResourceTypesResponse)

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