{-# 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.ActivateType
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Activates a public third-party extension, making it available for use in
-- stack templates. For more information, see
-- <https://docs.aws.amazon.com/AWSCloudFormation/latest/UserGuide/registry-public.html Using public extensions>
-- in the /CloudFormation User Guide/.
--
-- Once you have activated a public third-party extension in your account
-- and region, use
-- <AWSCloudFormation/latest/APIReference/API_SetTypeConfiguration.html SetTypeConfiguration>
-- to specify configuration properties for the extension. For more
-- information, see
-- <https://docs.aws.amazon.com/AWSCloudFormation/latest/UserGuide/registry-register.html#registry-set-configuration Configuring extensions at the account level>
-- in the /CloudFormation User Guide/.
module Amazonka.CloudFormation.ActivateType
  ( -- * Creating a Request
    ActivateType (..),
    newActivateType,

    -- * Request Lenses
    activateType_autoUpdate,
    activateType_executionRoleArn,
    activateType_loggingConfig,
    activateType_majorVersion,
    activateType_publicTypeArn,
    activateType_publisherId,
    activateType_type,
    activateType_typeName,
    activateType_typeNameAlias,
    activateType_versionBump,

    -- * Destructuring the Response
    ActivateTypeResponse (..),
    newActivateTypeResponse,

    -- * Response Lenses
    activateTypeResponse_arn,
    activateTypeResponse_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:/ 'newActivateType' smart constructor.
data ActivateType = ActivateType'
  { -- | Whether to automatically update the extension in this account and region
    -- when a new /minor/ version is published by the extension publisher.
    -- Major versions released by the publisher must be manually updated.
    --
    -- The default is @true@.
    ActivateType -> Maybe Bool
autoUpdate :: Prelude.Maybe Prelude.Bool,
    -- | The name of the IAM execution role to use to activate the extension.
    ActivateType -> Maybe Text
executionRoleArn :: Prelude.Maybe Prelude.Text,
    ActivateType -> Maybe LoggingConfig
loggingConfig :: Prelude.Maybe LoggingConfig,
    -- | The major version of this extension you want to activate, if multiple
    -- major versions are available. The default is the latest major version.
    -- CloudFormation uses the latest available /minor/ version of the major
    -- version selected.
    --
    -- You can specify @MajorVersion@ or @VersionBump@, but not both.
    ActivateType -> Maybe Natural
majorVersion :: Prelude.Maybe Prelude.Natural,
    -- | The Amazon Resource Name (ARN) of the public extension.
    --
    -- Conditional: You must specify @PublicTypeArn@, or @TypeName@, @Type@,
    -- and @PublisherId@.
    ActivateType -> Maybe Text
publicTypeArn :: Prelude.Maybe Prelude.Text,
    -- | The ID of the extension publisher.
    --
    -- Conditional: You must specify @PublicTypeArn@, or @TypeName@, @Type@,
    -- and @PublisherId@.
    ActivateType -> Maybe Text
publisherId :: Prelude.Maybe Prelude.Text,
    -- | The extension type.
    --
    -- Conditional: You must specify @PublicTypeArn@, or @TypeName@, @Type@,
    -- and @PublisherId@.
    ActivateType -> Maybe ThirdPartyType
type' :: Prelude.Maybe ThirdPartyType,
    -- | The name of the extension.
    --
    -- Conditional: You must specify @PublicTypeArn@, or @TypeName@, @Type@,
    -- and @PublisherId@.
    ActivateType -> Maybe Text
typeName :: Prelude.Maybe Prelude.Text,
    -- | An alias to assign to the public extension, in this account and region.
    -- If you specify an alias for the extension, CloudFormation treats the
    -- alias as the extension type name within this account and region. You
    -- must use the alias to refer to the extension in your templates, API
    -- calls, and CloudFormation console.
    --
    -- An extension alias must be unique within a given account and region. You
    -- can activate the same public resource multiple times in the same account
    -- and region, using different type name aliases.
    ActivateType -> Maybe Text
typeNameAlias :: Prelude.Maybe Prelude.Text,
    -- | Manually updates a previously-activated type to a new major or minor
    -- version, if available. You can also use this parameter to update the
    -- value of @AutoUpdate@.
    --
    -- -   @MAJOR@: CloudFormation updates the extension to the newest major
    --     version, if one is available.
    --
    -- -   @MINOR@: CloudFormation updates the extension to the newest minor
    --     version, if one is available.
    ActivateType -> Maybe VersionBump
versionBump :: Prelude.Maybe VersionBump
  }
  deriving (ActivateType -> ActivateType -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ActivateType -> ActivateType -> Bool
$c/= :: ActivateType -> ActivateType -> Bool
== :: ActivateType -> ActivateType -> Bool
$c== :: ActivateType -> ActivateType -> Bool
Prelude.Eq, ReadPrec [ActivateType]
ReadPrec ActivateType
Int -> ReadS ActivateType
ReadS [ActivateType]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ActivateType]
$creadListPrec :: ReadPrec [ActivateType]
readPrec :: ReadPrec ActivateType
$creadPrec :: ReadPrec ActivateType
readList :: ReadS [ActivateType]
$creadList :: ReadS [ActivateType]
readsPrec :: Int -> ReadS ActivateType
$creadsPrec :: Int -> ReadS ActivateType
Prelude.Read, Int -> ActivateType -> ShowS
[ActivateType] -> ShowS
ActivateType -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ActivateType] -> ShowS
$cshowList :: [ActivateType] -> ShowS
show :: ActivateType -> String
$cshow :: ActivateType -> String
showsPrec :: Int -> ActivateType -> ShowS
$cshowsPrec :: Int -> ActivateType -> ShowS
Prelude.Show, forall x. Rep ActivateType x -> ActivateType
forall x. ActivateType -> Rep ActivateType x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ActivateType x -> ActivateType
$cfrom :: forall x. ActivateType -> Rep ActivateType x
Prelude.Generic)

-- |
-- Create a value of 'ActivateType' 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:
--
-- 'autoUpdate', 'activateType_autoUpdate' - Whether to automatically update the extension in this account and region
-- when a new /minor/ version is published by the extension publisher.
-- Major versions released by the publisher must be manually updated.
--
-- The default is @true@.
--
-- 'executionRoleArn', 'activateType_executionRoleArn' - The name of the IAM execution role to use to activate the extension.
--
-- 'loggingConfig', 'activateType_loggingConfig' - Undocumented member.
--
-- 'majorVersion', 'activateType_majorVersion' - The major version of this extension you want to activate, if multiple
-- major versions are available. The default is the latest major version.
-- CloudFormation uses the latest available /minor/ version of the major
-- version selected.
--
-- You can specify @MajorVersion@ or @VersionBump@, but not both.
--
-- 'publicTypeArn', 'activateType_publicTypeArn' - The Amazon Resource Name (ARN) of the public extension.
--
-- Conditional: You must specify @PublicTypeArn@, or @TypeName@, @Type@,
-- and @PublisherId@.
--
-- 'publisherId', 'activateType_publisherId' - The ID of the extension publisher.
--
-- Conditional: You must specify @PublicTypeArn@, or @TypeName@, @Type@,
-- and @PublisherId@.
--
-- 'type'', 'activateType_type' - The extension type.
--
-- Conditional: You must specify @PublicTypeArn@, or @TypeName@, @Type@,
-- and @PublisherId@.
--
-- 'typeName', 'activateType_typeName' - The name of the extension.
--
-- Conditional: You must specify @PublicTypeArn@, or @TypeName@, @Type@,
-- and @PublisherId@.
--
-- 'typeNameAlias', 'activateType_typeNameAlias' - An alias to assign to the public extension, in this account and region.
-- If you specify an alias for the extension, CloudFormation treats the
-- alias as the extension type name within this account and region. You
-- must use the alias to refer to the extension in your templates, API
-- calls, and CloudFormation console.
--
-- An extension alias must be unique within a given account and region. You
-- can activate the same public resource multiple times in the same account
-- and region, using different type name aliases.
--
-- 'versionBump', 'activateType_versionBump' - Manually updates a previously-activated type to a new major or minor
-- version, if available. You can also use this parameter to update the
-- value of @AutoUpdate@.
--
-- -   @MAJOR@: CloudFormation updates the extension to the newest major
--     version, if one is available.
--
-- -   @MINOR@: CloudFormation updates the extension to the newest minor
--     version, if one is available.
newActivateType ::
  ActivateType
newActivateType :: ActivateType
newActivateType =
  ActivateType'
    { $sel:autoUpdate:ActivateType' :: Maybe Bool
autoUpdate = forall a. Maybe a
Prelude.Nothing,
      $sel:executionRoleArn:ActivateType' :: Maybe Text
executionRoleArn = forall a. Maybe a
Prelude.Nothing,
      $sel:loggingConfig:ActivateType' :: Maybe LoggingConfig
loggingConfig = forall a. Maybe a
Prelude.Nothing,
      $sel:majorVersion:ActivateType' :: Maybe Natural
majorVersion = forall a. Maybe a
Prelude.Nothing,
      $sel:publicTypeArn:ActivateType' :: Maybe Text
publicTypeArn = forall a. Maybe a
Prelude.Nothing,
      $sel:publisherId:ActivateType' :: Maybe Text
publisherId = forall a. Maybe a
Prelude.Nothing,
      $sel:type':ActivateType' :: Maybe ThirdPartyType
type' = forall a. Maybe a
Prelude.Nothing,
      $sel:typeName:ActivateType' :: Maybe Text
typeName = forall a. Maybe a
Prelude.Nothing,
      $sel:typeNameAlias:ActivateType' :: Maybe Text
typeNameAlias = forall a. Maybe a
Prelude.Nothing,
      $sel:versionBump:ActivateType' :: Maybe VersionBump
versionBump = forall a. Maybe a
Prelude.Nothing
    }

-- | Whether to automatically update the extension in this account and region
-- when a new /minor/ version is published by the extension publisher.
-- Major versions released by the publisher must be manually updated.
--
-- The default is @true@.
activateType_autoUpdate :: Lens.Lens' ActivateType (Prelude.Maybe Prelude.Bool)
activateType_autoUpdate :: Lens' ActivateType (Maybe Bool)
activateType_autoUpdate = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ActivateType' {Maybe Bool
autoUpdate :: Maybe Bool
$sel:autoUpdate:ActivateType' :: ActivateType -> Maybe Bool
autoUpdate} -> Maybe Bool
autoUpdate) (\s :: ActivateType
s@ActivateType' {} Maybe Bool
a -> ActivateType
s {$sel:autoUpdate:ActivateType' :: Maybe Bool
autoUpdate = Maybe Bool
a} :: ActivateType)

-- | The name of the IAM execution role to use to activate the extension.
activateType_executionRoleArn :: Lens.Lens' ActivateType (Prelude.Maybe Prelude.Text)
activateType_executionRoleArn :: Lens' ActivateType (Maybe Text)
activateType_executionRoleArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ActivateType' {Maybe Text
executionRoleArn :: Maybe Text
$sel:executionRoleArn:ActivateType' :: ActivateType -> Maybe Text
executionRoleArn} -> Maybe Text
executionRoleArn) (\s :: ActivateType
s@ActivateType' {} Maybe Text
a -> ActivateType
s {$sel:executionRoleArn:ActivateType' :: Maybe Text
executionRoleArn = Maybe Text
a} :: ActivateType)

-- | Undocumented member.
activateType_loggingConfig :: Lens.Lens' ActivateType (Prelude.Maybe LoggingConfig)
activateType_loggingConfig :: Lens' ActivateType (Maybe LoggingConfig)
activateType_loggingConfig = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ActivateType' {Maybe LoggingConfig
loggingConfig :: Maybe LoggingConfig
$sel:loggingConfig:ActivateType' :: ActivateType -> Maybe LoggingConfig
loggingConfig} -> Maybe LoggingConfig
loggingConfig) (\s :: ActivateType
s@ActivateType' {} Maybe LoggingConfig
a -> ActivateType
s {$sel:loggingConfig:ActivateType' :: Maybe LoggingConfig
loggingConfig = Maybe LoggingConfig
a} :: ActivateType)

-- | The major version of this extension you want to activate, if multiple
-- major versions are available. The default is the latest major version.
-- CloudFormation uses the latest available /minor/ version of the major
-- version selected.
--
-- You can specify @MajorVersion@ or @VersionBump@, but not both.
activateType_majorVersion :: Lens.Lens' ActivateType (Prelude.Maybe Prelude.Natural)
activateType_majorVersion :: Lens' ActivateType (Maybe Natural)
activateType_majorVersion = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ActivateType' {Maybe Natural
majorVersion :: Maybe Natural
$sel:majorVersion:ActivateType' :: ActivateType -> Maybe Natural
majorVersion} -> Maybe Natural
majorVersion) (\s :: ActivateType
s@ActivateType' {} Maybe Natural
a -> ActivateType
s {$sel:majorVersion:ActivateType' :: Maybe Natural
majorVersion = Maybe Natural
a} :: ActivateType)

-- | The Amazon Resource Name (ARN) of the public extension.
--
-- Conditional: You must specify @PublicTypeArn@, or @TypeName@, @Type@,
-- and @PublisherId@.
activateType_publicTypeArn :: Lens.Lens' ActivateType (Prelude.Maybe Prelude.Text)
activateType_publicTypeArn :: Lens' ActivateType (Maybe Text)
activateType_publicTypeArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ActivateType' {Maybe Text
publicTypeArn :: Maybe Text
$sel:publicTypeArn:ActivateType' :: ActivateType -> Maybe Text
publicTypeArn} -> Maybe Text
publicTypeArn) (\s :: ActivateType
s@ActivateType' {} Maybe Text
a -> ActivateType
s {$sel:publicTypeArn:ActivateType' :: Maybe Text
publicTypeArn = Maybe Text
a} :: ActivateType)

-- | The ID of the extension publisher.
--
-- Conditional: You must specify @PublicTypeArn@, or @TypeName@, @Type@,
-- and @PublisherId@.
activateType_publisherId :: Lens.Lens' ActivateType (Prelude.Maybe Prelude.Text)
activateType_publisherId :: Lens' ActivateType (Maybe Text)
activateType_publisherId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ActivateType' {Maybe Text
publisherId :: Maybe Text
$sel:publisherId:ActivateType' :: ActivateType -> Maybe Text
publisherId} -> Maybe Text
publisherId) (\s :: ActivateType
s@ActivateType' {} Maybe Text
a -> ActivateType
s {$sel:publisherId:ActivateType' :: Maybe Text
publisherId = Maybe Text
a} :: ActivateType)

-- | The extension type.
--
-- Conditional: You must specify @PublicTypeArn@, or @TypeName@, @Type@,
-- and @PublisherId@.
activateType_type :: Lens.Lens' ActivateType (Prelude.Maybe ThirdPartyType)
activateType_type :: Lens' ActivateType (Maybe ThirdPartyType)
activateType_type = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ActivateType' {Maybe ThirdPartyType
type' :: Maybe ThirdPartyType
$sel:type':ActivateType' :: ActivateType -> Maybe ThirdPartyType
type'} -> Maybe ThirdPartyType
type') (\s :: ActivateType
s@ActivateType' {} Maybe ThirdPartyType
a -> ActivateType
s {$sel:type':ActivateType' :: Maybe ThirdPartyType
type' = Maybe ThirdPartyType
a} :: ActivateType)

-- | The name of the extension.
--
-- Conditional: You must specify @PublicTypeArn@, or @TypeName@, @Type@,
-- and @PublisherId@.
activateType_typeName :: Lens.Lens' ActivateType (Prelude.Maybe Prelude.Text)
activateType_typeName :: Lens' ActivateType (Maybe Text)
activateType_typeName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ActivateType' {Maybe Text
typeName :: Maybe Text
$sel:typeName:ActivateType' :: ActivateType -> Maybe Text
typeName} -> Maybe Text
typeName) (\s :: ActivateType
s@ActivateType' {} Maybe Text
a -> ActivateType
s {$sel:typeName:ActivateType' :: Maybe Text
typeName = Maybe Text
a} :: ActivateType)

-- | An alias to assign to the public extension, in this account and region.
-- If you specify an alias for the extension, CloudFormation treats the
-- alias as the extension type name within this account and region. You
-- must use the alias to refer to the extension in your templates, API
-- calls, and CloudFormation console.
--
-- An extension alias must be unique within a given account and region. You
-- can activate the same public resource multiple times in the same account
-- and region, using different type name aliases.
activateType_typeNameAlias :: Lens.Lens' ActivateType (Prelude.Maybe Prelude.Text)
activateType_typeNameAlias :: Lens' ActivateType (Maybe Text)
activateType_typeNameAlias = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ActivateType' {Maybe Text
typeNameAlias :: Maybe Text
$sel:typeNameAlias:ActivateType' :: ActivateType -> Maybe Text
typeNameAlias} -> Maybe Text
typeNameAlias) (\s :: ActivateType
s@ActivateType' {} Maybe Text
a -> ActivateType
s {$sel:typeNameAlias:ActivateType' :: Maybe Text
typeNameAlias = Maybe Text
a} :: ActivateType)

-- | Manually updates a previously-activated type to a new major or minor
-- version, if available. You can also use this parameter to update the
-- value of @AutoUpdate@.
--
-- -   @MAJOR@: CloudFormation updates the extension to the newest major
--     version, if one is available.
--
-- -   @MINOR@: CloudFormation updates the extension to the newest minor
--     version, if one is available.
activateType_versionBump :: Lens.Lens' ActivateType (Prelude.Maybe VersionBump)
activateType_versionBump :: Lens' ActivateType (Maybe VersionBump)
activateType_versionBump = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ActivateType' {Maybe VersionBump
versionBump :: Maybe VersionBump
$sel:versionBump:ActivateType' :: ActivateType -> Maybe VersionBump
versionBump} -> Maybe VersionBump
versionBump) (\s :: ActivateType
s@ActivateType' {} Maybe VersionBump
a -> ActivateType
s {$sel:versionBump:ActivateType' :: Maybe VersionBump
versionBump = Maybe VersionBump
a} :: ActivateType)

instance Core.AWSRequest ActivateType where
  type AWSResponse ActivateType = ActivateTypeResponse
  request :: (Service -> Service) -> ActivateType -> Request ActivateType
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 ActivateType
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse ActivateType)))
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
"ActivateTypeResult"
      ( \Int
s ResponseHeaders
h [Node]
x ->
          Maybe Text -> Int -> ActivateTypeResponse
ActivateTypeResponse'
            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
"Arn")
            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 ActivateType where
  hashWithSalt :: Int -> ActivateType -> Int
hashWithSalt Int
_salt ActivateType' {Maybe Bool
Maybe Natural
Maybe Text
Maybe LoggingConfig
Maybe ThirdPartyType
Maybe VersionBump
versionBump :: Maybe VersionBump
typeNameAlias :: Maybe Text
typeName :: Maybe Text
type' :: Maybe ThirdPartyType
publisherId :: Maybe Text
publicTypeArn :: Maybe Text
majorVersion :: Maybe Natural
loggingConfig :: Maybe LoggingConfig
executionRoleArn :: Maybe Text
autoUpdate :: Maybe Bool
$sel:versionBump:ActivateType' :: ActivateType -> Maybe VersionBump
$sel:typeNameAlias:ActivateType' :: ActivateType -> Maybe Text
$sel:typeName:ActivateType' :: ActivateType -> Maybe Text
$sel:type':ActivateType' :: ActivateType -> Maybe ThirdPartyType
$sel:publisherId:ActivateType' :: ActivateType -> Maybe Text
$sel:publicTypeArn:ActivateType' :: ActivateType -> Maybe Text
$sel:majorVersion:ActivateType' :: ActivateType -> Maybe Natural
$sel:loggingConfig:ActivateType' :: ActivateType -> Maybe LoggingConfig
$sel:executionRoleArn:ActivateType' :: ActivateType -> Maybe Text
$sel:autoUpdate:ActivateType' :: ActivateType -> Maybe Bool
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Bool
autoUpdate
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
executionRoleArn
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe LoggingConfig
loggingConfig
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Natural
majorVersion
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
publicTypeArn
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
publisherId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe ThirdPartyType
type'
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
typeName
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
typeNameAlias
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe VersionBump
versionBump

instance Prelude.NFData ActivateType where
  rnf :: ActivateType -> ()
rnf ActivateType' {Maybe Bool
Maybe Natural
Maybe Text
Maybe LoggingConfig
Maybe ThirdPartyType
Maybe VersionBump
versionBump :: Maybe VersionBump
typeNameAlias :: Maybe Text
typeName :: Maybe Text
type' :: Maybe ThirdPartyType
publisherId :: Maybe Text
publicTypeArn :: Maybe Text
majorVersion :: Maybe Natural
loggingConfig :: Maybe LoggingConfig
executionRoleArn :: Maybe Text
autoUpdate :: Maybe Bool
$sel:versionBump:ActivateType' :: ActivateType -> Maybe VersionBump
$sel:typeNameAlias:ActivateType' :: ActivateType -> Maybe Text
$sel:typeName:ActivateType' :: ActivateType -> Maybe Text
$sel:type':ActivateType' :: ActivateType -> Maybe ThirdPartyType
$sel:publisherId:ActivateType' :: ActivateType -> Maybe Text
$sel:publicTypeArn:ActivateType' :: ActivateType -> Maybe Text
$sel:majorVersion:ActivateType' :: ActivateType -> Maybe Natural
$sel:loggingConfig:ActivateType' :: ActivateType -> Maybe LoggingConfig
$sel:executionRoleArn:ActivateType' :: ActivateType -> Maybe Text
$sel:autoUpdate:ActivateType' :: ActivateType -> Maybe Bool
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Bool
autoUpdate
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
executionRoleArn
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe LoggingConfig
loggingConfig
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Natural
majorVersion
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
publicTypeArn
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
publisherId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe ThirdPartyType
type'
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
typeName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
typeNameAlias
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe VersionBump
versionBump

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

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

instance Data.ToQuery ActivateType where
  toQuery :: ActivateType -> QueryString
toQuery ActivateType' {Maybe Bool
Maybe Natural
Maybe Text
Maybe LoggingConfig
Maybe ThirdPartyType
Maybe VersionBump
versionBump :: Maybe VersionBump
typeNameAlias :: Maybe Text
typeName :: Maybe Text
type' :: Maybe ThirdPartyType
publisherId :: Maybe Text
publicTypeArn :: Maybe Text
majorVersion :: Maybe Natural
loggingConfig :: Maybe LoggingConfig
executionRoleArn :: Maybe Text
autoUpdate :: Maybe Bool
$sel:versionBump:ActivateType' :: ActivateType -> Maybe VersionBump
$sel:typeNameAlias:ActivateType' :: ActivateType -> Maybe Text
$sel:typeName:ActivateType' :: ActivateType -> Maybe Text
$sel:type':ActivateType' :: ActivateType -> Maybe ThirdPartyType
$sel:publisherId:ActivateType' :: ActivateType -> Maybe Text
$sel:publicTypeArn:ActivateType' :: ActivateType -> Maybe Text
$sel:majorVersion:ActivateType' :: ActivateType -> Maybe Natural
$sel:loggingConfig:ActivateType' :: ActivateType -> Maybe LoggingConfig
$sel:executionRoleArn:ActivateType' :: ActivateType -> Maybe Text
$sel:autoUpdate:ActivateType' :: ActivateType -> Maybe Bool
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"Action"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: (ByteString
"ActivateType" :: Prelude.ByteString),
        ByteString
"Version"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: (ByteString
"2010-05-15" :: Prelude.ByteString),
        ByteString
"AutoUpdate" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Bool
autoUpdate,
        ByteString
"ExecutionRoleArn" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Text
executionRoleArn,
        ByteString
"LoggingConfig" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe LoggingConfig
loggingConfig,
        ByteString
"MajorVersion" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Natural
majorVersion,
        ByteString
"PublicTypeArn" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Text
publicTypeArn,
        ByteString
"PublisherId" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Text
publisherId,
        ByteString
"Type" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe ThirdPartyType
type',
        ByteString
"TypeName" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Text
typeName,
        ByteString
"TypeNameAlias" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Text
typeNameAlias,
        ByteString
"VersionBump" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe VersionBump
versionBump
      ]

-- | /See:/ 'newActivateTypeResponse' smart constructor.
data ActivateTypeResponse = ActivateTypeResponse'
  { -- | The Amazon Resource Name (ARN) of the activated extension, in this
    -- account and region.
    ActivateTypeResponse -> Maybe Text
arn :: Prelude.Maybe Prelude.Text,
    -- | The response's http status code.
    ActivateTypeResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (ActivateTypeResponse -> ActivateTypeResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ActivateTypeResponse -> ActivateTypeResponse -> Bool
$c/= :: ActivateTypeResponse -> ActivateTypeResponse -> Bool
== :: ActivateTypeResponse -> ActivateTypeResponse -> Bool
$c== :: ActivateTypeResponse -> ActivateTypeResponse -> Bool
Prelude.Eq, ReadPrec [ActivateTypeResponse]
ReadPrec ActivateTypeResponse
Int -> ReadS ActivateTypeResponse
ReadS [ActivateTypeResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ActivateTypeResponse]
$creadListPrec :: ReadPrec [ActivateTypeResponse]
readPrec :: ReadPrec ActivateTypeResponse
$creadPrec :: ReadPrec ActivateTypeResponse
readList :: ReadS [ActivateTypeResponse]
$creadList :: ReadS [ActivateTypeResponse]
readsPrec :: Int -> ReadS ActivateTypeResponse
$creadsPrec :: Int -> ReadS ActivateTypeResponse
Prelude.Read, Int -> ActivateTypeResponse -> ShowS
[ActivateTypeResponse] -> ShowS
ActivateTypeResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ActivateTypeResponse] -> ShowS
$cshowList :: [ActivateTypeResponse] -> ShowS
show :: ActivateTypeResponse -> String
$cshow :: ActivateTypeResponse -> String
showsPrec :: Int -> ActivateTypeResponse -> ShowS
$cshowsPrec :: Int -> ActivateTypeResponse -> ShowS
Prelude.Show, forall x. Rep ActivateTypeResponse x -> ActivateTypeResponse
forall x. ActivateTypeResponse -> Rep ActivateTypeResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ActivateTypeResponse x -> ActivateTypeResponse
$cfrom :: forall x. ActivateTypeResponse -> Rep ActivateTypeResponse x
Prelude.Generic)

-- |
-- Create a value of 'ActivateTypeResponse' 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:
--
-- 'arn', 'activateTypeResponse_arn' - The Amazon Resource Name (ARN) of the activated extension, in this
-- account and region.
--
-- 'httpStatus', 'activateTypeResponse_httpStatus' - The response's http status code.
newActivateTypeResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  ActivateTypeResponse
newActivateTypeResponse :: Int -> ActivateTypeResponse
newActivateTypeResponse Int
pHttpStatus_ =
  ActivateTypeResponse'
    { $sel:arn:ActivateTypeResponse' :: Maybe Text
arn = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:ActivateTypeResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | The Amazon Resource Name (ARN) of the activated extension, in this
-- account and region.
activateTypeResponse_arn :: Lens.Lens' ActivateTypeResponse (Prelude.Maybe Prelude.Text)
activateTypeResponse_arn :: Lens' ActivateTypeResponse (Maybe Text)
activateTypeResponse_arn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ActivateTypeResponse' {Maybe Text
arn :: Maybe Text
$sel:arn:ActivateTypeResponse' :: ActivateTypeResponse -> Maybe Text
arn} -> Maybe Text
arn) (\s :: ActivateTypeResponse
s@ActivateTypeResponse' {} Maybe Text
a -> ActivateTypeResponse
s {$sel:arn:ActivateTypeResponse' :: Maybe Text
arn = Maybe Text
a} :: ActivateTypeResponse)

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

instance Prelude.NFData ActivateTypeResponse where
  rnf :: ActivateTypeResponse -> ()
rnf ActivateTypeResponse' {Int
Maybe Text
httpStatus :: Int
arn :: Maybe Text
$sel:httpStatus:ActivateTypeResponse' :: ActivateTypeResponse -> Int
$sel:arn:ActivateTypeResponse' :: ActivateTypeResponse -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
arn
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus