{-# 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.SetTypeConfiguration
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Specifies the configuration data for a registered CloudFormation
-- extension, in the given account and region.
--
-- To view the current configuration data for an extension, refer to the
-- @ConfigurationSchema@ element of
-- <AWSCloudFormation/latest/APIReference/API_DescribeType.html DescribeType>.
-- 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/.
--
-- It\'s strongly recommended that you use dynamic references to restrict
-- sensitive configuration definitions, such as third-party credentials.
-- For more details on dynamic references, see
-- <https://docs.aws.amazon.com/ Using dynamic references to specify template values>
-- in the /CloudFormation User Guide/.
module Amazonka.CloudFormation.SetTypeConfiguration
  ( -- * Creating a Request
    SetTypeConfiguration (..),
    newSetTypeConfiguration,

    -- * Request Lenses
    setTypeConfiguration_configurationAlias,
    setTypeConfiguration_type,
    setTypeConfiguration_typeArn,
    setTypeConfiguration_typeName,
    setTypeConfiguration_configuration,

    -- * Destructuring the Response
    SetTypeConfigurationResponse (..),
    newSetTypeConfigurationResponse,

    -- * Response Lenses
    setTypeConfigurationResponse_configurationArn,
    setTypeConfigurationResponse_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:/ 'newSetTypeConfiguration' smart constructor.
data SetTypeConfiguration = SetTypeConfiguration'
  { -- | An alias by which to refer to this extension configuration data.
    --
    -- Conditional: Specifying a configuration alias is required when setting a
    -- configuration for a resource type extension.
    SetTypeConfiguration -> Maybe Text
configurationAlias :: Prelude.Maybe Prelude.Text,
    -- | The type of extension.
    --
    -- Conditional: You must specify @ConfigurationArn@, or @Type@ and
    -- @TypeName@.
    SetTypeConfiguration -> Maybe ThirdPartyType
type' :: Prelude.Maybe ThirdPartyType,
    -- | The Amazon Resource Name (ARN) for the extension, in this account and
    -- region.
    --
    -- For public extensions, this will be the ARN assigned when you
    -- <https://docs.aws.amazon.com/AWSCloudFormation/latest/APIReference/API_ActivateType.html activate the type>
    -- in this account and region. For private extensions, this will be the ARN
    -- assigned when you
    -- <https://docs.aws.amazon.com/AWSCloudFormation/latest/APIReference/API_RegisterType.html register the type>
    -- in this account and region.
    --
    -- Do not include the extension versions suffix at the end of the ARN. You
    -- can set the configuration for an extension, but not for a specific
    -- extension version.
    SetTypeConfiguration -> Maybe Text
typeArn :: Prelude.Maybe Prelude.Text,
    -- | The name of the extension.
    --
    -- Conditional: You must specify @ConfigurationArn@, or @Type@ and
    -- @TypeName@.
    SetTypeConfiguration -> Maybe Text
typeName :: Prelude.Maybe Prelude.Text,
    -- | The configuration data for the extension, in this account and region.
    --
    -- The configuration data must be formatted as JSON, and validate against
    -- the schema returned in the @ConfigurationSchema@ response element of
    -- <AWSCloudFormation/latest/APIReference/API_DescribeType.html API_DescribeType>.
    -- For more information, see
    -- <https://docs.aws.amazon.com/cloudformation-cli/latest/userguide/resource-type-model.html#resource-type-howto-configuration Defining account-level configuration data for an extension>
    -- in the /CloudFormation CLI User Guide/.
    SetTypeConfiguration -> Text
configuration :: Prelude.Text
  }
  deriving (SetTypeConfiguration -> SetTypeConfiguration -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SetTypeConfiguration -> SetTypeConfiguration -> Bool
$c/= :: SetTypeConfiguration -> SetTypeConfiguration -> Bool
== :: SetTypeConfiguration -> SetTypeConfiguration -> Bool
$c== :: SetTypeConfiguration -> SetTypeConfiguration -> Bool
Prelude.Eq, ReadPrec [SetTypeConfiguration]
ReadPrec SetTypeConfiguration
Int -> ReadS SetTypeConfiguration
ReadS [SetTypeConfiguration]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [SetTypeConfiguration]
$creadListPrec :: ReadPrec [SetTypeConfiguration]
readPrec :: ReadPrec SetTypeConfiguration
$creadPrec :: ReadPrec SetTypeConfiguration
readList :: ReadS [SetTypeConfiguration]
$creadList :: ReadS [SetTypeConfiguration]
readsPrec :: Int -> ReadS SetTypeConfiguration
$creadsPrec :: Int -> ReadS SetTypeConfiguration
Prelude.Read, Int -> SetTypeConfiguration -> ShowS
[SetTypeConfiguration] -> ShowS
SetTypeConfiguration -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SetTypeConfiguration] -> ShowS
$cshowList :: [SetTypeConfiguration] -> ShowS
show :: SetTypeConfiguration -> String
$cshow :: SetTypeConfiguration -> String
showsPrec :: Int -> SetTypeConfiguration -> ShowS
$cshowsPrec :: Int -> SetTypeConfiguration -> ShowS
Prelude.Show, forall x. Rep SetTypeConfiguration x -> SetTypeConfiguration
forall x. SetTypeConfiguration -> Rep SetTypeConfiguration x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep SetTypeConfiguration x -> SetTypeConfiguration
$cfrom :: forall x. SetTypeConfiguration -> Rep SetTypeConfiguration x
Prelude.Generic)

-- |
-- Create a value of 'SetTypeConfiguration' 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:
--
-- 'configurationAlias', 'setTypeConfiguration_configurationAlias' - An alias by which to refer to this extension configuration data.
--
-- Conditional: Specifying a configuration alias is required when setting a
-- configuration for a resource type extension.
--
-- 'type'', 'setTypeConfiguration_type' - The type of extension.
--
-- Conditional: You must specify @ConfigurationArn@, or @Type@ and
-- @TypeName@.
--
-- 'typeArn', 'setTypeConfiguration_typeArn' - The Amazon Resource Name (ARN) for the extension, in this account and
-- region.
--
-- For public extensions, this will be the ARN assigned when you
-- <https://docs.aws.amazon.com/AWSCloudFormation/latest/APIReference/API_ActivateType.html activate the type>
-- in this account and region. For private extensions, this will be the ARN
-- assigned when you
-- <https://docs.aws.amazon.com/AWSCloudFormation/latest/APIReference/API_RegisterType.html register the type>
-- in this account and region.
--
-- Do not include the extension versions suffix at the end of the ARN. You
-- can set the configuration for an extension, but not for a specific
-- extension version.
--
-- 'typeName', 'setTypeConfiguration_typeName' - The name of the extension.
--
-- Conditional: You must specify @ConfigurationArn@, or @Type@ and
-- @TypeName@.
--
-- 'configuration', 'setTypeConfiguration_configuration' - The configuration data for the extension, in this account and region.
--
-- The configuration data must be formatted as JSON, and validate against
-- the schema returned in the @ConfigurationSchema@ response element of
-- <AWSCloudFormation/latest/APIReference/API_DescribeType.html API_DescribeType>.
-- For more information, see
-- <https://docs.aws.amazon.com/cloudformation-cli/latest/userguide/resource-type-model.html#resource-type-howto-configuration Defining account-level configuration data for an extension>
-- in the /CloudFormation CLI User Guide/.
newSetTypeConfiguration ::
  -- | 'configuration'
  Prelude.Text ->
  SetTypeConfiguration
newSetTypeConfiguration :: Text -> SetTypeConfiguration
newSetTypeConfiguration Text
pConfiguration_ =
  SetTypeConfiguration'
    { $sel:configurationAlias:SetTypeConfiguration' :: Maybe Text
configurationAlias =
        forall a. Maybe a
Prelude.Nothing,
      $sel:type':SetTypeConfiguration' :: Maybe ThirdPartyType
type' = forall a. Maybe a
Prelude.Nothing,
      $sel:typeArn:SetTypeConfiguration' :: Maybe Text
typeArn = forall a. Maybe a
Prelude.Nothing,
      $sel:typeName:SetTypeConfiguration' :: Maybe Text
typeName = forall a. Maybe a
Prelude.Nothing,
      $sel:configuration:SetTypeConfiguration' :: Text
configuration = Text
pConfiguration_
    }

-- | An alias by which to refer to this extension configuration data.
--
-- Conditional: Specifying a configuration alias is required when setting a
-- configuration for a resource type extension.
setTypeConfiguration_configurationAlias :: Lens.Lens' SetTypeConfiguration (Prelude.Maybe Prelude.Text)
setTypeConfiguration_configurationAlias :: Lens' SetTypeConfiguration (Maybe Text)
setTypeConfiguration_configurationAlias = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\SetTypeConfiguration' {Maybe Text
configurationAlias :: Maybe Text
$sel:configurationAlias:SetTypeConfiguration' :: SetTypeConfiguration -> Maybe Text
configurationAlias} -> Maybe Text
configurationAlias) (\s :: SetTypeConfiguration
s@SetTypeConfiguration' {} Maybe Text
a -> SetTypeConfiguration
s {$sel:configurationAlias:SetTypeConfiguration' :: Maybe Text
configurationAlias = Maybe Text
a} :: SetTypeConfiguration)

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

-- | The Amazon Resource Name (ARN) for the extension, in this account and
-- region.
--
-- For public extensions, this will be the ARN assigned when you
-- <https://docs.aws.amazon.com/AWSCloudFormation/latest/APIReference/API_ActivateType.html activate the type>
-- in this account and region. For private extensions, this will be the ARN
-- assigned when you
-- <https://docs.aws.amazon.com/AWSCloudFormation/latest/APIReference/API_RegisterType.html register the type>
-- in this account and region.
--
-- Do not include the extension versions suffix at the end of the ARN. You
-- can set the configuration for an extension, but not for a specific
-- extension version.
setTypeConfiguration_typeArn :: Lens.Lens' SetTypeConfiguration (Prelude.Maybe Prelude.Text)
setTypeConfiguration_typeArn :: Lens' SetTypeConfiguration (Maybe Text)
setTypeConfiguration_typeArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\SetTypeConfiguration' {Maybe Text
typeArn :: Maybe Text
$sel:typeArn:SetTypeConfiguration' :: SetTypeConfiguration -> Maybe Text
typeArn} -> Maybe Text
typeArn) (\s :: SetTypeConfiguration
s@SetTypeConfiguration' {} Maybe Text
a -> SetTypeConfiguration
s {$sel:typeArn:SetTypeConfiguration' :: Maybe Text
typeArn = Maybe Text
a} :: SetTypeConfiguration)

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

-- | The configuration data for the extension, in this account and region.
--
-- The configuration data must be formatted as JSON, and validate against
-- the schema returned in the @ConfigurationSchema@ response element of
-- <AWSCloudFormation/latest/APIReference/API_DescribeType.html API_DescribeType>.
-- For more information, see
-- <https://docs.aws.amazon.com/cloudformation-cli/latest/userguide/resource-type-model.html#resource-type-howto-configuration Defining account-level configuration data for an extension>
-- in the /CloudFormation CLI User Guide/.
setTypeConfiguration_configuration :: Lens.Lens' SetTypeConfiguration Prelude.Text
setTypeConfiguration_configuration :: Lens' SetTypeConfiguration Text
setTypeConfiguration_configuration = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\SetTypeConfiguration' {Text
configuration :: Text
$sel:configuration:SetTypeConfiguration' :: SetTypeConfiguration -> Text
configuration} -> Text
configuration) (\s :: SetTypeConfiguration
s@SetTypeConfiguration' {} Text
a -> SetTypeConfiguration
s {$sel:configuration:SetTypeConfiguration' :: Text
configuration = Text
a} :: SetTypeConfiguration)

instance Core.AWSRequest SetTypeConfiguration where
  type
    AWSResponse SetTypeConfiguration =
      SetTypeConfigurationResponse
  request :: (Service -> Service)
-> SetTypeConfiguration -> Request SetTypeConfiguration
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 SetTypeConfiguration
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse SetTypeConfiguration)))
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
"SetTypeConfigurationResult"
      ( \Int
s ResponseHeaders
h [Node]
x ->
          Maybe Text -> Int -> SetTypeConfigurationResponse
SetTypeConfigurationResponse'
            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
"ConfigurationArn")
            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 SetTypeConfiguration where
  hashWithSalt :: Int -> SetTypeConfiguration -> Int
hashWithSalt Int
_salt SetTypeConfiguration' {Maybe Text
Maybe ThirdPartyType
Text
configuration :: Text
typeName :: Maybe Text
typeArn :: Maybe Text
type' :: Maybe ThirdPartyType
configurationAlias :: Maybe Text
$sel:configuration:SetTypeConfiguration' :: SetTypeConfiguration -> Text
$sel:typeName:SetTypeConfiguration' :: SetTypeConfiguration -> Maybe Text
$sel:typeArn:SetTypeConfiguration' :: SetTypeConfiguration -> Maybe Text
$sel:type':SetTypeConfiguration' :: SetTypeConfiguration -> Maybe ThirdPartyType
$sel:configurationAlias:SetTypeConfiguration' :: SetTypeConfiguration -> Maybe Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
configurationAlias
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe ThirdPartyType
type'
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
typeArn
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
typeName
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
configuration

instance Prelude.NFData SetTypeConfiguration where
  rnf :: SetTypeConfiguration -> ()
rnf SetTypeConfiguration' {Maybe Text
Maybe ThirdPartyType
Text
configuration :: Text
typeName :: Maybe Text
typeArn :: Maybe Text
type' :: Maybe ThirdPartyType
configurationAlias :: Maybe Text
$sel:configuration:SetTypeConfiguration' :: SetTypeConfiguration -> Text
$sel:typeName:SetTypeConfiguration' :: SetTypeConfiguration -> Maybe Text
$sel:typeArn:SetTypeConfiguration' :: SetTypeConfiguration -> Maybe Text
$sel:type':SetTypeConfiguration' :: SetTypeConfiguration -> Maybe ThirdPartyType
$sel:configurationAlias:SetTypeConfiguration' :: SetTypeConfiguration -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
configurationAlias
      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
typeArn
      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 Text
configuration

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

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

instance Data.ToQuery SetTypeConfiguration where
  toQuery :: SetTypeConfiguration -> QueryString
toQuery SetTypeConfiguration' {Maybe Text
Maybe ThirdPartyType
Text
configuration :: Text
typeName :: Maybe Text
typeArn :: Maybe Text
type' :: Maybe ThirdPartyType
configurationAlias :: Maybe Text
$sel:configuration:SetTypeConfiguration' :: SetTypeConfiguration -> Text
$sel:typeName:SetTypeConfiguration' :: SetTypeConfiguration -> Maybe Text
$sel:typeArn:SetTypeConfiguration' :: SetTypeConfiguration -> Maybe Text
$sel:type':SetTypeConfiguration' :: SetTypeConfiguration -> Maybe ThirdPartyType
$sel:configurationAlias:SetTypeConfiguration' :: SetTypeConfiguration -> Maybe Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"Action"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: (ByteString
"SetTypeConfiguration" :: Prelude.ByteString),
        ByteString
"Version"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: (ByteString
"2010-05-15" :: Prelude.ByteString),
        ByteString
"ConfigurationAlias" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Text
configurationAlias,
        ByteString
"Type" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe ThirdPartyType
type',
        ByteString
"TypeArn" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Text
typeArn,
        ByteString
"TypeName" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Text
typeName,
        ByteString
"Configuration" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Text
configuration
      ]

-- | /See:/ 'newSetTypeConfigurationResponse' smart constructor.
data SetTypeConfigurationResponse = SetTypeConfigurationResponse'
  { -- | The Amazon Resource Name (ARN) for the configuration data, in this
    -- account and region.
    --
    -- Conditional: You must specify @ConfigurationArn@, or @Type@ and
    -- @TypeName@.
    SetTypeConfigurationResponse -> Maybe Text
configurationArn :: Prelude.Maybe Prelude.Text,
    -- | The response's http status code.
    SetTypeConfigurationResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (SetTypeConfigurationResponse
-> SetTypeConfigurationResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SetTypeConfigurationResponse
-> SetTypeConfigurationResponse -> Bool
$c/= :: SetTypeConfigurationResponse
-> SetTypeConfigurationResponse -> Bool
== :: SetTypeConfigurationResponse
-> SetTypeConfigurationResponse -> Bool
$c== :: SetTypeConfigurationResponse
-> SetTypeConfigurationResponse -> Bool
Prelude.Eq, ReadPrec [SetTypeConfigurationResponse]
ReadPrec SetTypeConfigurationResponse
Int -> ReadS SetTypeConfigurationResponse
ReadS [SetTypeConfigurationResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [SetTypeConfigurationResponse]
$creadListPrec :: ReadPrec [SetTypeConfigurationResponse]
readPrec :: ReadPrec SetTypeConfigurationResponse
$creadPrec :: ReadPrec SetTypeConfigurationResponse
readList :: ReadS [SetTypeConfigurationResponse]
$creadList :: ReadS [SetTypeConfigurationResponse]
readsPrec :: Int -> ReadS SetTypeConfigurationResponse
$creadsPrec :: Int -> ReadS SetTypeConfigurationResponse
Prelude.Read, Int -> SetTypeConfigurationResponse -> ShowS
[SetTypeConfigurationResponse] -> ShowS
SetTypeConfigurationResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SetTypeConfigurationResponse] -> ShowS
$cshowList :: [SetTypeConfigurationResponse] -> ShowS
show :: SetTypeConfigurationResponse -> String
$cshow :: SetTypeConfigurationResponse -> String
showsPrec :: Int -> SetTypeConfigurationResponse -> ShowS
$cshowsPrec :: Int -> SetTypeConfigurationResponse -> ShowS
Prelude.Show, forall x.
Rep SetTypeConfigurationResponse x -> SetTypeConfigurationResponse
forall x.
SetTypeConfigurationResponse -> Rep SetTypeConfigurationResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep SetTypeConfigurationResponse x -> SetTypeConfigurationResponse
$cfrom :: forall x.
SetTypeConfigurationResponse -> Rep SetTypeConfigurationResponse x
Prelude.Generic)

-- |
-- Create a value of 'SetTypeConfigurationResponse' 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:
--
-- 'configurationArn', 'setTypeConfigurationResponse_configurationArn' - The Amazon Resource Name (ARN) for the configuration data, in this
-- account and region.
--
-- Conditional: You must specify @ConfigurationArn@, or @Type@ and
-- @TypeName@.
--
-- 'httpStatus', 'setTypeConfigurationResponse_httpStatus' - The response's http status code.
newSetTypeConfigurationResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  SetTypeConfigurationResponse
newSetTypeConfigurationResponse :: Int -> SetTypeConfigurationResponse
newSetTypeConfigurationResponse Int
pHttpStatus_ =
  SetTypeConfigurationResponse'
    { $sel:configurationArn:SetTypeConfigurationResponse' :: Maybe Text
configurationArn =
        forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:SetTypeConfigurationResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | The Amazon Resource Name (ARN) for the configuration data, in this
-- account and region.
--
-- Conditional: You must specify @ConfigurationArn@, or @Type@ and
-- @TypeName@.
setTypeConfigurationResponse_configurationArn :: Lens.Lens' SetTypeConfigurationResponse (Prelude.Maybe Prelude.Text)
setTypeConfigurationResponse_configurationArn :: Lens' SetTypeConfigurationResponse (Maybe Text)
setTypeConfigurationResponse_configurationArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\SetTypeConfigurationResponse' {Maybe Text
configurationArn :: Maybe Text
$sel:configurationArn:SetTypeConfigurationResponse' :: SetTypeConfigurationResponse -> Maybe Text
configurationArn} -> Maybe Text
configurationArn) (\s :: SetTypeConfigurationResponse
s@SetTypeConfigurationResponse' {} Maybe Text
a -> SetTypeConfigurationResponse
s {$sel:configurationArn:SetTypeConfigurationResponse' :: Maybe Text
configurationArn = Maybe Text
a} :: SetTypeConfigurationResponse)

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

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