{-# 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.ListTypes
-- 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 summary information about extension that have been registered
-- with CloudFormation.
--
-- This operation returns paginated results.
module Amazonka.CloudFormation.ListTypes
  ( -- * Creating a Request
    ListTypes (..),
    newListTypes,

    -- * Request Lenses
    listTypes_deprecatedStatus,
    listTypes_filters,
    listTypes_maxResults,
    listTypes_nextToken,
    listTypes_provisioningType,
    listTypes_type,
    listTypes_visibility,

    -- * Destructuring the Response
    ListTypesResponse (..),
    newListTypesResponse,

    -- * Response Lenses
    listTypesResponse_nextToken,
    listTypesResponse_typeSummaries,
    listTypesResponse_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

-- | /See:/ 'newListTypes' smart constructor.
data ListTypes = ListTypes'
  { -- | The deprecation status of the extension that you want to get summary
    -- information about.
    --
    -- Valid values include:
    --
    -- -   @LIVE@: The extension is registered for use in CloudFormation
    --     operations.
    --
    -- -   @DEPRECATED@: The extension has been deregistered and can no longer
    --     be used in CloudFormation operations.
    ListTypes -> Maybe DeprecatedStatus
deprecatedStatus :: Prelude.Maybe DeprecatedStatus,
    -- | Filter criteria to use in determining which extensions to return.
    --
    -- Filters must be compatible with @Visibility@ to return valid results.
    -- For example, specifying @AWS_TYPES@ for @Category@ and @PRIVATE@ for
    -- @Visibility@ returns an empty list of types, but specifying @PUBLIC@ for
    -- @Visibility@ returns the desired list.
    ListTypes -> Maybe TypeFilters
filters :: Prelude.Maybe TypeFilters,
    -- | The maximum number of results to be returned with a single call. If the
    -- number of available results exceeds this maximum, the response includes
    -- a @NextToken@ value that you can assign to the @NextToken@ request
    -- parameter to get the next set of results.
    ListTypes -> Maybe Natural
maxResults :: Prelude.Maybe Prelude.Natural,
    -- | If the previous paginated request didn\'t return all the remaining
    -- results, the response object\'s @NextToken@ parameter value is set to a
    -- token. To retrieve the next set of results, call this action again and
    -- assign that token to the request object\'s @NextToken@ parameter. If
    -- there are no remaining results, the previous response object\'s
    -- @NextToken@ parameter is set to @null@.
    ListTypes -> Maybe Text
nextToken :: Prelude.Maybe Prelude.Text,
    -- | For resource types, the provisioning behavior of the resource type.
    -- CloudFormation determines the provisioning type during registration,
    -- based on the types of handlers in the schema handler package submitted.
    --
    -- Valid values include:
    --
    -- -   @FULLY_MUTABLE@: The resource type includes an update handler to
    --     process updates to the type during stack update operations.
    --
    -- -   @IMMUTABLE@: The resource type doesn\'t include an update handler,
    --     so the type can\'t be updated and must instead be replaced during
    --     stack update operations.
    --
    -- -   @NON_PROVISIONABLE@: The resource type doesn\'t include create,
    --     read, and delete handlers, and therefore can\'t actually be
    --     provisioned.
    --
    -- The default is @FULLY_MUTABLE@.
    ListTypes -> Maybe ProvisioningType
provisioningType :: Prelude.Maybe ProvisioningType,
    -- | The type of extension.
    ListTypes -> Maybe RegistryType
type' :: Prelude.Maybe RegistryType,
    -- | The scope at which the extensions are visible and usable in
    -- CloudFormation operations.
    --
    -- Valid values include:
    --
    -- -   @PRIVATE@: Extensions that are visible and usable within this
    --     account and region. This includes:
    --
    --     -   Private extensions you have registered in this account and
    --         region.
    --
    --     -   Public extensions that you have activated in this account and
    --         region.
    --
    -- -   @PUBLIC@: Extensions that are publicly visible and available to be
    --     activated within any Amazon Web Services account. This includes
    --     extensions from Amazon Web Services, in addition to third-party
    --     publishers.
    --
    -- The default is @PRIVATE@.
    ListTypes -> Maybe Visibility
visibility :: Prelude.Maybe Visibility
  }
  deriving (ListTypes -> ListTypes -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ListTypes -> ListTypes -> Bool
$c/= :: ListTypes -> ListTypes -> Bool
== :: ListTypes -> ListTypes -> Bool
$c== :: ListTypes -> ListTypes -> Bool
Prelude.Eq, ReadPrec [ListTypes]
ReadPrec ListTypes
Int -> ReadS ListTypes
ReadS [ListTypes]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ListTypes]
$creadListPrec :: ReadPrec [ListTypes]
readPrec :: ReadPrec ListTypes
$creadPrec :: ReadPrec ListTypes
readList :: ReadS [ListTypes]
$creadList :: ReadS [ListTypes]
readsPrec :: Int -> ReadS ListTypes
$creadsPrec :: Int -> ReadS ListTypes
Prelude.Read, Int -> ListTypes -> ShowS
[ListTypes] -> ShowS
ListTypes -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ListTypes] -> ShowS
$cshowList :: [ListTypes] -> ShowS
show :: ListTypes -> String
$cshow :: ListTypes -> String
showsPrec :: Int -> ListTypes -> ShowS
$cshowsPrec :: Int -> ListTypes -> ShowS
Prelude.Show, forall x. Rep ListTypes x -> ListTypes
forall x. ListTypes -> Rep ListTypes x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ListTypes x -> ListTypes
$cfrom :: forall x. ListTypes -> Rep ListTypes x
Prelude.Generic)

-- |
-- Create a value of 'ListTypes' 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:
--
-- 'deprecatedStatus', 'listTypes_deprecatedStatus' - The deprecation status of the extension that you want to get summary
-- information about.
--
-- Valid values include:
--
-- -   @LIVE@: The extension is registered for use in CloudFormation
--     operations.
--
-- -   @DEPRECATED@: The extension has been deregistered and can no longer
--     be used in CloudFormation operations.
--
-- 'filters', 'listTypes_filters' - Filter criteria to use in determining which extensions to return.
--
-- Filters must be compatible with @Visibility@ to return valid results.
-- For example, specifying @AWS_TYPES@ for @Category@ and @PRIVATE@ for
-- @Visibility@ returns an empty list of types, but specifying @PUBLIC@ for
-- @Visibility@ returns the desired list.
--
-- 'maxResults', 'listTypes_maxResults' - The maximum number of results to be returned with a single call. If the
-- number of available results exceeds this maximum, the response includes
-- a @NextToken@ value that you can assign to the @NextToken@ request
-- parameter to get the next set of results.
--
-- 'nextToken', 'listTypes_nextToken' - If the previous paginated request didn\'t return all the remaining
-- results, the response object\'s @NextToken@ parameter value is set to a
-- token. To retrieve the next set of results, call this action again and
-- assign that token to the request object\'s @NextToken@ parameter. If
-- there are no remaining results, the previous response object\'s
-- @NextToken@ parameter is set to @null@.
--
-- 'provisioningType', 'listTypes_provisioningType' - For resource types, the provisioning behavior of the resource type.
-- CloudFormation determines the provisioning type during registration,
-- based on the types of handlers in the schema handler package submitted.
--
-- Valid values include:
--
-- -   @FULLY_MUTABLE@: The resource type includes an update handler to
--     process updates to the type during stack update operations.
--
-- -   @IMMUTABLE@: The resource type doesn\'t include an update handler,
--     so the type can\'t be updated and must instead be replaced during
--     stack update operations.
--
-- -   @NON_PROVISIONABLE@: The resource type doesn\'t include create,
--     read, and delete handlers, and therefore can\'t actually be
--     provisioned.
--
-- The default is @FULLY_MUTABLE@.
--
-- 'type'', 'listTypes_type' - The type of extension.
--
-- 'visibility', 'listTypes_visibility' - The scope at which the extensions are visible and usable in
-- CloudFormation operations.
--
-- Valid values include:
--
-- -   @PRIVATE@: Extensions that are visible and usable within this
--     account and region. This includes:
--
--     -   Private extensions you have registered in this account and
--         region.
--
--     -   Public extensions that you have activated in this account and
--         region.
--
-- -   @PUBLIC@: Extensions that are publicly visible and available to be
--     activated within any Amazon Web Services account. This includes
--     extensions from Amazon Web Services, in addition to third-party
--     publishers.
--
-- The default is @PRIVATE@.
newListTypes ::
  ListTypes
newListTypes :: ListTypes
newListTypes =
  ListTypes'
    { $sel:deprecatedStatus:ListTypes' :: Maybe DeprecatedStatus
deprecatedStatus = forall a. Maybe a
Prelude.Nothing,
      $sel:filters:ListTypes' :: Maybe TypeFilters
filters = forall a. Maybe a
Prelude.Nothing,
      $sel:maxResults:ListTypes' :: Maybe Natural
maxResults = forall a. Maybe a
Prelude.Nothing,
      $sel:nextToken:ListTypes' :: Maybe Text
nextToken = forall a. Maybe a
Prelude.Nothing,
      $sel:provisioningType:ListTypes' :: Maybe ProvisioningType
provisioningType = forall a. Maybe a
Prelude.Nothing,
      $sel:type':ListTypes' :: Maybe RegistryType
type' = forall a. Maybe a
Prelude.Nothing,
      $sel:visibility:ListTypes' :: Maybe Visibility
visibility = forall a. Maybe a
Prelude.Nothing
    }

-- | The deprecation status of the extension that you want to get summary
-- information about.
--
-- Valid values include:
--
-- -   @LIVE@: The extension is registered for use in CloudFormation
--     operations.
--
-- -   @DEPRECATED@: The extension has been deregistered and can no longer
--     be used in CloudFormation operations.
listTypes_deprecatedStatus :: Lens.Lens' ListTypes (Prelude.Maybe DeprecatedStatus)
listTypes_deprecatedStatus :: Lens' ListTypes (Maybe DeprecatedStatus)
listTypes_deprecatedStatus = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListTypes' {Maybe DeprecatedStatus
deprecatedStatus :: Maybe DeprecatedStatus
$sel:deprecatedStatus:ListTypes' :: ListTypes -> Maybe DeprecatedStatus
deprecatedStatus} -> Maybe DeprecatedStatus
deprecatedStatus) (\s :: ListTypes
s@ListTypes' {} Maybe DeprecatedStatus
a -> ListTypes
s {$sel:deprecatedStatus:ListTypes' :: Maybe DeprecatedStatus
deprecatedStatus = Maybe DeprecatedStatus
a} :: ListTypes)

-- | Filter criteria to use in determining which extensions to return.
--
-- Filters must be compatible with @Visibility@ to return valid results.
-- For example, specifying @AWS_TYPES@ for @Category@ and @PRIVATE@ for
-- @Visibility@ returns an empty list of types, but specifying @PUBLIC@ for
-- @Visibility@ returns the desired list.
listTypes_filters :: Lens.Lens' ListTypes (Prelude.Maybe TypeFilters)
listTypes_filters :: Lens' ListTypes (Maybe TypeFilters)
listTypes_filters = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListTypes' {Maybe TypeFilters
filters :: Maybe TypeFilters
$sel:filters:ListTypes' :: ListTypes -> Maybe TypeFilters
filters} -> Maybe TypeFilters
filters) (\s :: ListTypes
s@ListTypes' {} Maybe TypeFilters
a -> ListTypes
s {$sel:filters:ListTypes' :: Maybe TypeFilters
filters = Maybe TypeFilters
a} :: ListTypes)

-- | The maximum number of results to be returned with a single call. If the
-- number of available results exceeds this maximum, the response includes
-- a @NextToken@ value that you can assign to the @NextToken@ request
-- parameter to get the next set of results.
listTypes_maxResults :: Lens.Lens' ListTypes (Prelude.Maybe Prelude.Natural)
listTypes_maxResults :: Lens' ListTypes (Maybe Natural)
listTypes_maxResults = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListTypes' {Maybe Natural
maxResults :: Maybe Natural
$sel:maxResults:ListTypes' :: ListTypes -> Maybe Natural
maxResults} -> Maybe Natural
maxResults) (\s :: ListTypes
s@ListTypes' {} Maybe Natural
a -> ListTypes
s {$sel:maxResults:ListTypes' :: Maybe Natural
maxResults = Maybe Natural
a} :: ListTypes)

-- | If the previous paginated request didn\'t return all the remaining
-- results, the response object\'s @NextToken@ parameter value is set to a
-- token. To retrieve the next set of results, call this action again and
-- assign that token to the request object\'s @NextToken@ parameter. If
-- there are no remaining results, the previous response object\'s
-- @NextToken@ parameter is set to @null@.
listTypes_nextToken :: Lens.Lens' ListTypes (Prelude.Maybe Prelude.Text)
listTypes_nextToken :: Lens' ListTypes (Maybe Text)
listTypes_nextToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListTypes' {Maybe Text
nextToken :: Maybe Text
$sel:nextToken:ListTypes' :: ListTypes -> Maybe Text
nextToken} -> Maybe Text
nextToken) (\s :: ListTypes
s@ListTypes' {} Maybe Text
a -> ListTypes
s {$sel:nextToken:ListTypes' :: Maybe Text
nextToken = Maybe Text
a} :: ListTypes)

-- | For resource types, the provisioning behavior of the resource type.
-- CloudFormation determines the provisioning type during registration,
-- based on the types of handlers in the schema handler package submitted.
--
-- Valid values include:
--
-- -   @FULLY_MUTABLE@: The resource type includes an update handler to
--     process updates to the type during stack update operations.
--
-- -   @IMMUTABLE@: The resource type doesn\'t include an update handler,
--     so the type can\'t be updated and must instead be replaced during
--     stack update operations.
--
-- -   @NON_PROVISIONABLE@: The resource type doesn\'t include create,
--     read, and delete handlers, and therefore can\'t actually be
--     provisioned.
--
-- The default is @FULLY_MUTABLE@.
listTypes_provisioningType :: Lens.Lens' ListTypes (Prelude.Maybe ProvisioningType)
listTypes_provisioningType :: Lens' ListTypes (Maybe ProvisioningType)
listTypes_provisioningType = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListTypes' {Maybe ProvisioningType
provisioningType :: Maybe ProvisioningType
$sel:provisioningType:ListTypes' :: ListTypes -> Maybe ProvisioningType
provisioningType} -> Maybe ProvisioningType
provisioningType) (\s :: ListTypes
s@ListTypes' {} Maybe ProvisioningType
a -> ListTypes
s {$sel:provisioningType:ListTypes' :: Maybe ProvisioningType
provisioningType = Maybe ProvisioningType
a} :: ListTypes)

-- | The type of extension.
listTypes_type :: Lens.Lens' ListTypes (Prelude.Maybe RegistryType)
listTypes_type :: Lens' ListTypes (Maybe RegistryType)
listTypes_type = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListTypes' {Maybe RegistryType
type' :: Maybe RegistryType
$sel:type':ListTypes' :: ListTypes -> Maybe RegistryType
type'} -> Maybe RegistryType
type') (\s :: ListTypes
s@ListTypes' {} Maybe RegistryType
a -> ListTypes
s {$sel:type':ListTypes' :: Maybe RegistryType
type' = Maybe RegistryType
a} :: ListTypes)

-- | The scope at which the extensions are visible and usable in
-- CloudFormation operations.
--
-- Valid values include:
--
-- -   @PRIVATE@: Extensions that are visible and usable within this
--     account and region. This includes:
--
--     -   Private extensions you have registered in this account and
--         region.
--
--     -   Public extensions that you have activated in this account and
--         region.
--
-- -   @PUBLIC@: Extensions that are publicly visible and available to be
--     activated within any Amazon Web Services account. This includes
--     extensions from Amazon Web Services, in addition to third-party
--     publishers.
--
-- The default is @PRIVATE@.
listTypes_visibility :: Lens.Lens' ListTypes (Prelude.Maybe Visibility)
listTypes_visibility :: Lens' ListTypes (Maybe Visibility)
listTypes_visibility = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListTypes' {Maybe Visibility
visibility :: Maybe Visibility
$sel:visibility:ListTypes' :: ListTypes -> Maybe Visibility
visibility} -> Maybe Visibility
visibility) (\s :: ListTypes
s@ListTypes' {} Maybe Visibility
a -> ListTypes
s {$sel:visibility:ListTypes' :: Maybe Visibility
visibility = Maybe Visibility
a} :: ListTypes)

instance Core.AWSPager ListTypes where
  page :: ListTypes -> AWSResponse ListTypes -> Maybe ListTypes
page ListTypes
rq AWSResponse ListTypes
rs
    | forall a. AWSTruncated a => a -> Bool
Core.stop
        ( AWSResponse ListTypes
rs
            forall s a. s -> Getting (First a) s a -> Maybe a
Lens.^? Lens' ListTypesResponse (Maybe Text)
listTypesResponse_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 ListTypes
rs
            forall s a. s -> Getting (First a) s a -> Maybe a
Lens.^? Lens' ListTypesResponse (Maybe [TypeSummary])
listTypesResponse_typeSummaries
            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.$ ListTypes
rq
          forall a b. a -> (a -> b) -> b
Prelude.& Lens' ListTypes (Maybe Text)
listTypes_nextToken
          forall s t a b. ASetter s t a b -> b -> s -> t
Lens..~ AWSResponse ListTypes
rs
          forall s a. s -> Getting (First a) s a -> Maybe a
Lens.^? Lens' ListTypesResponse (Maybe Text)
listTypesResponse_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 ListTypes where
  type AWSResponse ListTypes = ListTypesResponse
  request :: (Service -> Service) -> ListTypes -> Request ListTypes
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 ListTypes
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse ListTypes)))
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
"ListTypesResult"
      ( \Int
s ResponseHeaders
h [Node]
x ->
          Maybe Text -> Maybe [TypeSummary] -> Int -> ListTypesResponse
ListTypesResponse'
            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
"TypeSummaries"
                            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 ListTypes where
  hashWithSalt :: Int -> ListTypes -> Int
hashWithSalt Int
_salt ListTypes' {Maybe Natural
Maybe Text
Maybe DeprecatedStatus
Maybe ProvisioningType
Maybe RegistryType
Maybe TypeFilters
Maybe Visibility
visibility :: Maybe Visibility
type' :: Maybe RegistryType
provisioningType :: Maybe ProvisioningType
nextToken :: Maybe Text
maxResults :: Maybe Natural
filters :: Maybe TypeFilters
deprecatedStatus :: Maybe DeprecatedStatus
$sel:visibility:ListTypes' :: ListTypes -> Maybe Visibility
$sel:type':ListTypes' :: ListTypes -> Maybe RegistryType
$sel:provisioningType:ListTypes' :: ListTypes -> Maybe ProvisioningType
$sel:nextToken:ListTypes' :: ListTypes -> Maybe Text
$sel:maxResults:ListTypes' :: ListTypes -> Maybe Natural
$sel:filters:ListTypes' :: ListTypes -> Maybe TypeFilters
$sel:deprecatedStatus:ListTypes' :: ListTypes -> Maybe DeprecatedStatus
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe DeprecatedStatus
deprecatedStatus
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe TypeFilters
filters
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Natural
maxResults
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
nextToken
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe ProvisioningType
provisioningType
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe RegistryType
type'
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Visibility
visibility

instance Prelude.NFData ListTypes where
  rnf :: ListTypes -> ()
rnf ListTypes' {Maybe Natural
Maybe Text
Maybe DeprecatedStatus
Maybe ProvisioningType
Maybe RegistryType
Maybe TypeFilters
Maybe Visibility
visibility :: Maybe Visibility
type' :: Maybe RegistryType
provisioningType :: Maybe ProvisioningType
nextToken :: Maybe Text
maxResults :: Maybe Natural
filters :: Maybe TypeFilters
deprecatedStatus :: Maybe DeprecatedStatus
$sel:visibility:ListTypes' :: ListTypes -> Maybe Visibility
$sel:type':ListTypes' :: ListTypes -> Maybe RegistryType
$sel:provisioningType:ListTypes' :: ListTypes -> Maybe ProvisioningType
$sel:nextToken:ListTypes' :: ListTypes -> Maybe Text
$sel:maxResults:ListTypes' :: ListTypes -> Maybe Natural
$sel:filters:ListTypes' :: ListTypes -> Maybe TypeFilters
$sel:deprecatedStatus:ListTypes' :: ListTypes -> Maybe DeprecatedStatus
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe DeprecatedStatus
deprecatedStatus
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe TypeFilters
filters
      seq :: forall a b. a -> b -> b
`Prelude.seq` 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
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe ProvisioningType
provisioningType
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe RegistryType
type'
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Visibility
visibility

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

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

instance Data.ToQuery ListTypes where
  toQuery :: ListTypes -> QueryString
toQuery ListTypes' {Maybe Natural
Maybe Text
Maybe DeprecatedStatus
Maybe ProvisioningType
Maybe RegistryType
Maybe TypeFilters
Maybe Visibility
visibility :: Maybe Visibility
type' :: Maybe RegistryType
provisioningType :: Maybe ProvisioningType
nextToken :: Maybe Text
maxResults :: Maybe Natural
filters :: Maybe TypeFilters
deprecatedStatus :: Maybe DeprecatedStatus
$sel:visibility:ListTypes' :: ListTypes -> Maybe Visibility
$sel:type':ListTypes' :: ListTypes -> Maybe RegistryType
$sel:provisioningType:ListTypes' :: ListTypes -> Maybe ProvisioningType
$sel:nextToken:ListTypes' :: ListTypes -> Maybe Text
$sel:maxResults:ListTypes' :: ListTypes -> Maybe Natural
$sel:filters:ListTypes' :: ListTypes -> Maybe TypeFilters
$sel:deprecatedStatus:ListTypes' :: ListTypes -> Maybe DeprecatedStatus
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"Action"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: (ByteString
"ListTypes" :: Prelude.ByteString),
        ByteString
"Version"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: (ByteString
"2010-05-15" :: Prelude.ByteString),
        ByteString
"DeprecatedStatus" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe DeprecatedStatus
deprecatedStatus,
        ByteString
"Filters" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe TypeFilters
filters,
        ByteString
"MaxResults" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Natural
maxResults,
        ByteString
"NextToken" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Text
nextToken,
        ByteString
"ProvisioningType" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe ProvisioningType
provisioningType,
        ByteString
"Type" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe RegistryType
type',
        ByteString
"Visibility" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Visibility
visibility
      ]

-- | /See:/ 'newListTypesResponse' smart constructor.
data ListTypesResponse = ListTypesResponse'
  { -- | If the request doesn\'t return all the remaining results, @NextToken@ is
    -- set to a token. To retrieve the next set of results, call this action
    -- again and assign that token to the request object\'s @NextToken@
    -- parameter. If the request returns all results, @NextToken@ is set to
    -- @null@.
    ListTypesResponse -> Maybe Text
nextToken :: Prelude.Maybe Prelude.Text,
    -- | A list of @TypeSummary@ structures that contain information about the
    -- specified extensions.
    ListTypesResponse -> Maybe [TypeSummary]
typeSummaries :: Prelude.Maybe [TypeSummary],
    -- | The response's http status code.
    ListTypesResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (ListTypesResponse -> ListTypesResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ListTypesResponse -> ListTypesResponse -> Bool
$c/= :: ListTypesResponse -> ListTypesResponse -> Bool
== :: ListTypesResponse -> ListTypesResponse -> Bool
$c== :: ListTypesResponse -> ListTypesResponse -> Bool
Prelude.Eq, ReadPrec [ListTypesResponse]
ReadPrec ListTypesResponse
Int -> ReadS ListTypesResponse
ReadS [ListTypesResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ListTypesResponse]
$creadListPrec :: ReadPrec [ListTypesResponse]
readPrec :: ReadPrec ListTypesResponse
$creadPrec :: ReadPrec ListTypesResponse
readList :: ReadS [ListTypesResponse]
$creadList :: ReadS [ListTypesResponse]
readsPrec :: Int -> ReadS ListTypesResponse
$creadsPrec :: Int -> ReadS ListTypesResponse
Prelude.Read, Int -> ListTypesResponse -> ShowS
[ListTypesResponse] -> ShowS
ListTypesResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ListTypesResponse] -> ShowS
$cshowList :: [ListTypesResponse] -> ShowS
show :: ListTypesResponse -> String
$cshow :: ListTypesResponse -> String
showsPrec :: Int -> ListTypesResponse -> ShowS
$cshowsPrec :: Int -> ListTypesResponse -> ShowS
Prelude.Show, forall x. Rep ListTypesResponse x -> ListTypesResponse
forall x. ListTypesResponse -> Rep ListTypesResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ListTypesResponse x -> ListTypesResponse
$cfrom :: forall x. ListTypesResponse -> Rep ListTypesResponse x
Prelude.Generic)

-- |
-- Create a value of 'ListTypesResponse' 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', 'listTypesResponse_nextToken' - If the request doesn\'t return all the remaining results, @NextToken@ is
-- set to a token. To retrieve the next set of results, call this action
-- again and assign that token to the request object\'s @NextToken@
-- parameter. If the request returns all results, @NextToken@ is set to
-- @null@.
--
-- 'typeSummaries', 'listTypesResponse_typeSummaries' - A list of @TypeSummary@ structures that contain information about the
-- specified extensions.
--
-- 'httpStatus', 'listTypesResponse_httpStatus' - The response's http status code.
newListTypesResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  ListTypesResponse
newListTypesResponse :: Int -> ListTypesResponse
newListTypesResponse Int
pHttpStatus_ =
  ListTypesResponse'
    { $sel:nextToken:ListTypesResponse' :: Maybe Text
nextToken = forall a. Maybe a
Prelude.Nothing,
      $sel:typeSummaries:ListTypesResponse' :: Maybe [TypeSummary]
typeSummaries = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:ListTypesResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | If the request doesn\'t return all the remaining results, @NextToken@ is
-- set to a token. To retrieve the next set of results, call this action
-- again and assign that token to the request object\'s @NextToken@
-- parameter. If the request returns all results, @NextToken@ is set to
-- @null@.
listTypesResponse_nextToken :: Lens.Lens' ListTypesResponse (Prelude.Maybe Prelude.Text)
listTypesResponse_nextToken :: Lens' ListTypesResponse (Maybe Text)
listTypesResponse_nextToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListTypesResponse' {Maybe Text
nextToken :: Maybe Text
$sel:nextToken:ListTypesResponse' :: ListTypesResponse -> Maybe Text
nextToken} -> Maybe Text
nextToken) (\s :: ListTypesResponse
s@ListTypesResponse' {} Maybe Text
a -> ListTypesResponse
s {$sel:nextToken:ListTypesResponse' :: Maybe Text
nextToken = Maybe Text
a} :: ListTypesResponse)

-- | A list of @TypeSummary@ structures that contain information about the
-- specified extensions.
listTypesResponse_typeSummaries :: Lens.Lens' ListTypesResponse (Prelude.Maybe [TypeSummary])
listTypesResponse_typeSummaries :: Lens' ListTypesResponse (Maybe [TypeSummary])
listTypesResponse_typeSummaries = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListTypesResponse' {Maybe [TypeSummary]
typeSummaries :: Maybe [TypeSummary]
$sel:typeSummaries:ListTypesResponse' :: ListTypesResponse -> Maybe [TypeSummary]
typeSummaries} -> Maybe [TypeSummary]
typeSummaries) (\s :: ListTypesResponse
s@ListTypesResponse' {} Maybe [TypeSummary]
a -> ListTypesResponse
s {$sel:typeSummaries:ListTypesResponse' :: Maybe [TypeSummary]
typeSummaries = Maybe [TypeSummary]
a} :: ListTypesResponse) 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.
listTypesResponse_httpStatus :: Lens.Lens' ListTypesResponse Prelude.Int
listTypesResponse_httpStatus :: Lens' ListTypesResponse Int
listTypesResponse_httpStatus = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListTypesResponse' {Int
httpStatus :: Int
$sel:httpStatus:ListTypesResponse' :: ListTypesResponse -> Int
httpStatus} -> Int
httpStatus) (\s :: ListTypesResponse
s@ListTypesResponse' {} Int
a -> ListTypesResponse
s {$sel:httpStatus:ListTypesResponse' :: Int
httpStatus = Int
a} :: ListTypesResponse)

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