{-# 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.Config.PutResourceConfig
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Records the configuration state for the resource provided in the
-- request. The configuration state of a resource is represented in Config
-- as Configuration Items. Once this API records the configuration item,
-- you can retrieve the list of configuration items for the custom resource
-- type using existing Config APIs.
--
-- The custom resource type must be registered with CloudFormation. This
-- API accepts the configuration item registered with CloudFormation.
--
-- When you call this API, Config only stores configuration state of the
-- resource provided in the request. This API does not change or remediate
-- the configuration of the resource.
--
-- Write-only schema properites are not recorded as part of the published
-- configuration item.
module Amazonka.Config.PutResourceConfig
  ( -- * Creating a Request
    PutResourceConfig (..),
    newPutResourceConfig,

    -- * Request Lenses
    putResourceConfig_resourceName,
    putResourceConfig_tags,
    putResourceConfig_resourceType,
    putResourceConfig_schemaVersionId,
    putResourceConfig_resourceId,
    putResourceConfig_configuration,

    -- * Destructuring the Response
    PutResourceConfigResponse (..),
    newPutResourceConfigResponse,
  )
where

import Amazonka.Config.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:/ 'newPutResourceConfig' smart constructor.
data PutResourceConfig = PutResourceConfig'
  { -- | Name of the resource.
    PutResourceConfig -> Maybe Text
resourceName :: Prelude.Maybe Prelude.Text,
    -- | Tags associated with the resource.
    --
    -- This field is not to be confused with the Amazon Web Services-wide tag
    -- feature for Amazon Web Services resources. Tags for @PutResourceConfig@
    -- are tags that you supply for the configuration items of your custom
    -- resources.
    PutResourceConfig -> Maybe (HashMap Text Text)
tags :: Prelude.Maybe (Prelude.HashMap Prelude.Text Prelude.Text),
    -- | The type of the resource. The custom resource type must be registered
    -- with CloudFormation.
    --
    -- You cannot use the organization names “amzn”, “amazon”, “alexa”,
    -- “custom” with custom resource types. It is the first part of the
    -- ResourceType up to the first ::.
    PutResourceConfig -> Text
resourceType :: Prelude.Text,
    -- | Version of the schema registered for the ResourceType in CloudFormation.
    PutResourceConfig -> Text
schemaVersionId :: Prelude.Text,
    -- | Unique identifier of the resource.
    PutResourceConfig -> Text
resourceId :: Prelude.Text,
    -- | The configuration object of the resource in valid JSON format. It must
    -- match the schema registered with CloudFormation.
    --
    -- The configuration JSON must not exceed 64 KB.
    PutResourceConfig -> Text
configuration :: Prelude.Text
  }
  deriving (PutResourceConfig -> PutResourceConfig -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PutResourceConfig -> PutResourceConfig -> Bool
$c/= :: PutResourceConfig -> PutResourceConfig -> Bool
== :: PutResourceConfig -> PutResourceConfig -> Bool
$c== :: PutResourceConfig -> PutResourceConfig -> Bool
Prelude.Eq, ReadPrec [PutResourceConfig]
ReadPrec PutResourceConfig
Int -> ReadS PutResourceConfig
ReadS [PutResourceConfig]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [PutResourceConfig]
$creadListPrec :: ReadPrec [PutResourceConfig]
readPrec :: ReadPrec PutResourceConfig
$creadPrec :: ReadPrec PutResourceConfig
readList :: ReadS [PutResourceConfig]
$creadList :: ReadS [PutResourceConfig]
readsPrec :: Int -> ReadS PutResourceConfig
$creadsPrec :: Int -> ReadS PutResourceConfig
Prelude.Read, Int -> PutResourceConfig -> ShowS
[PutResourceConfig] -> ShowS
PutResourceConfig -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PutResourceConfig] -> ShowS
$cshowList :: [PutResourceConfig] -> ShowS
show :: PutResourceConfig -> String
$cshow :: PutResourceConfig -> String
showsPrec :: Int -> PutResourceConfig -> ShowS
$cshowsPrec :: Int -> PutResourceConfig -> ShowS
Prelude.Show, forall x. Rep PutResourceConfig x -> PutResourceConfig
forall x. PutResourceConfig -> Rep PutResourceConfig x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep PutResourceConfig x -> PutResourceConfig
$cfrom :: forall x. PutResourceConfig -> Rep PutResourceConfig x
Prelude.Generic)

-- |
-- Create a value of 'PutResourceConfig' 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:
--
-- 'resourceName', 'putResourceConfig_resourceName' - Name of the resource.
--
-- 'tags', 'putResourceConfig_tags' - Tags associated with the resource.
--
-- This field is not to be confused with the Amazon Web Services-wide tag
-- feature for Amazon Web Services resources. Tags for @PutResourceConfig@
-- are tags that you supply for the configuration items of your custom
-- resources.
--
-- 'resourceType', 'putResourceConfig_resourceType' - The type of the resource. The custom resource type must be registered
-- with CloudFormation.
--
-- You cannot use the organization names “amzn”, “amazon”, “alexa”,
-- “custom” with custom resource types. It is the first part of the
-- ResourceType up to the first ::.
--
-- 'schemaVersionId', 'putResourceConfig_schemaVersionId' - Version of the schema registered for the ResourceType in CloudFormation.
--
-- 'resourceId', 'putResourceConfig_resourceId' - Unique identifier of the resource.
--
-- 'configuration', 'putResourceConfig_configuration' - The configuration object of the resource in valid JSON format. It must
-- match the schema registered with CloudFormation.
--
-- The configuration JSON must not exceed 64 KB.
newPutResourceConfig ::
  -- | 'resourceType'
  Prelude.Text ->
  -- | 'schemaVersionId'
  Prelude.Text ->
  -- | 'resourceId'
  Prelude.Text ->
  -- | 'configuration'
  Prelude.Text ->
  PutResourceConfig
newPutResourceConfig :: Text -> Text -> Text -> Text -> PutResourceConfig
newPutResourceConfig
  Text
pResourceType_
  Text
pSchemaVersionId_
  Text
pResourceId_
  Text
pConfiguration_ =
    PutResourceConfig'
      { $sel:resourceName:PutResourceConfig' :: Maybe Text
resourceName = forall a. Maybe a
Prelude.Nothing,
        $sel:tags:PutResourceConfig' :: Maybe (HashMap Text Text)
tags = forall a. Maybe a
Prelude.Nothing,
        $sel:resourceType:PutResourceConfig' :: Text
resourceType = Text
pResourceType_,
        $sel:schemaVersionId:PutResourceConfig' :: Text
schemaVersionId = Text
pSchemaVersionId_,
        $sel:resourceId:PutResourceConfig' :: Text
resourceId = Text
pResourceId_,
        $sel:configuration:PutResourceConfig' :: Text
configuration = Text
pConfiguration_
      }

-- | Name of the resource.
putResourceConfig_resourceName :: Lens.Lens' PutResourceConfig (Prelude.Maybe Prelude.Text)
putResourceConfig_resourceName :: Lens' PutResourceConfig (Maybe Text)
putResourceConfig_resourceName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PutResourceConfig' {Maybe Text
resourceName :: Maybe Text
$sel:resourceName:PutResourceConfig' :: PutResourceConfig -> Maybe Text
resourceName} -> Maybe Text
resourceName) (\s :: PutResourceConfig
s@PutResourceConfig' {} Maybe Text
a -> PutResourceConfig
s {$sel:resourceName:PutResourceConfig' :: Maybe Text
resourceName = Maybe Text
a} :: PutResourceConfig)

-- | Tags associated with the resource.
--
-- This field is not to be confused with the Amazon Web Services-wide tag
-- feature for Amazon Web Services resources. Tags for @PutResourceConfig@
-- are tags that you supply for the configuration items of your custom
-- resources.
putResourceConfig_tags :: Lens.Lens' PutResourceConfig (Prelude.Maybe (Prelude.HashMap Prelude.Text Prelude.Text))
putResourceConfig_tags :: Lens' PutResourceConfig (Maybe (HashMap Text Text))
putResourceConfig_tags = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PutResourceConfig' {Maybe (HashMap Text Text)
tags :: Maybe (HashMap Text Text)
$sel:tags:PutResourceConfig' :: PutResourceConfig -> Maybe (HashMap Text Text)
tags} -> Maybe (HashMap Text Text)
tags) (\s :: PutResourceConfig
s@PutResourceConfig' {} Maybe (HashMap Text Text)
a -> PutResourceConfig
s {$sel:tags:PutResourceConfig' :: Maybe (HashMap Text Text)
tags = Maybe (HashMap Text Text)
a} :: PutResourceConfig) 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 type of the resource. The custom resource type must be registered
-- with CloudFormation.
--
-- You cannot use the organization names “amzn”, “amazon”, “alexa”,
-- “custom” with custom resource types. It is the first part of the
-- ResourceType up to the first ::.
putResourceConfig_resourceType :: Lens.Lens' PutResourceConfig Prelude.Text
putResourceConfig_resourceType :: Lens' PutResourceConfig Text
putResourceConfig_resourceType = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PutResourceConfig' {Text
resourceType :: Text
$sel:resourceType:PutResourceConfig' :: PutResourceConfig -> Text
resourceType} -> Text
resourceType) (\s :: PutResourceConfig
s@PutResourceConfig' {} Text
a -> PutResourceConfig
s {$sel:resourceType:PutResourceConfig' :: Text
resourceType = Text
a} :: PutResourceConfig)

-- | Version of the schema registered for the ResourceType in CloudFormation.
putResourceConfig_schemaVersionId :: Lens.Lens' PutResourceConfig Prelude.Text
putResourceConfig_schemaVersionId :: Lens' PutResourceConfig Text
putResourceConfig_schemaVersionId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PutResourceConfig' {Text
schemaVersionId :: Text
$sel:schemaVersionId:PutResourceConfig' :: PutResourceConfig -> Text
schemaVersionId} -> Text
schemaVersionId) (\s :: PutResourceConfig
s@PutResourceConfig' {} Text
a -> PutResourceConfig
s {$sel:schemaVersionId:PutResourceConfig' :: Text
schemaVersionId = Text
a} :: PutResourceConfig)

-- | Unique identifier of the resource.
putResourceConfig_resourceId :: Lens.Lens' PutResourceConfig Prelude.Text
putResourceConfig_resourceId :: Lens' PutResourceConfig Text
putResourceConfig_resourceId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PutResourceConfig' {Text
resourceId :: Text
$sel:resourceId:PutResourceConfig' :: PutResourceConfig -> Text
resourceId} -> Text
resourceId) (\s :: PutResourceConfig
s@PutResourceConfig' {} Text
a -> PutResourceConfig
s {$sel:resourceId:PutResourceConfig' :: Text
resourceId = Text
a} :: PutResourceConfig)

-- | The configuration object of the resource in valid JSON format. It must
-- match the schema registered with CloudFormation.
--
-- The configuration JSON must not exceed 64 KB.
putResourceConfig_configuration :: Lens.Lens' PutResourceConfig Prelude.Text
putResourceConfig_configuration :: Lens' PutResourceConfig Text
putResourceConfig_configuration = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PutResourceConfig' {Text
configuration :: Text
$sel:configuration:PutResourceConfig' :: PutResourceConfig -> Text
configuration} -> Text
configuration) (\s :: PutResourceConfig
s@PutResourceConfig' {} Text
a -> PutResourceConfig
s {$sel:configuration:PutResourceConfig' :: Text
configuration = Text
a} :: PutResourceConfig)

instance Core.AWSRequest PutResourceConfig where
  type
    AWSResponse PutResourceConfig =
      PutResourceConfigResponse
  request :: (Service -> Service)
-> PutResourceConfig -> Request PutResourceConfig
request Service -> Service
overrides =
    forall a. (ToRequest a, ToJSON a) => Service -> a -> Request a
Request.postJSON (Service -> Service
overrides Service
defaultService)
  response :: forall (m :: * -> *).
MonadResource m =>
(ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy PutResourceConfig
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse PutResourceConfig)))
response =
    forall (m :: * -> *) a.
MonadResource m =>
AWSResponse a
-> (ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy a
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse a)))
Response.receiveNull PutResourceConfigResponse
PutResourceConfigResponse'

instance Prelude.Hashable PutResourceConfig where
  hashWithSalt :: Int -> PutResourceConfig -> Int
hashWithSalt Int
_salt PutResourceConfig' {Maybe Text
Maybe (HashMap Text Text)
Text
configuration :: Text
resourceId :: Text
schemaVersionId :: Text
resourceType :: Text
tags :: Maybe (HashMap Text Text)
resourceName :: Maybe Text
$sel:configuration:PutResourceConfig' :: PutResourceConfig -> Text
$sel:resourceId:PutResourceConfig' :: PutResourceConfig -> Text
$sel:schemaVersionId:PutResourceConfig' :: PutResourceConfig -> Text
$sel:resourceType:PutResourceConfig' :: PutResourceConfig -> Text
$sel:tags:PutResourceConfig' :: PutResourceConfig -> Maybe (HashMap Text Text)
$sel:resourceName:PutResourceConfig' :: PutResourceConfig -> Maybe Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
resourceName
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe (HashMap Text Text)
tags
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
resourceType
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
schemaVersionId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
resourceId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
configuration

instance Prelude.NFData PutResourceConfig where
  rnf :: PutResourceConfig -> ()
rnf PutResourceConfig' {Maybe Text
Maybe (HashMap Text Text)
Text
configuration :: Text
resourceId :: Text
schemaVersionId :: Text
resourceType :: Text
tags :: Maybe (HashMap Text Text)
resourceName :: Maybe Text
$sel:configuration:PutResourceConfig' :: PutResourceConfig -> Text
$sel:resourceId:PutResourceConfig' :: PutResourceConfig -> Text
$sel:schemaVersionId:PutResourceConfig' :: PutResourceConfig -> Text
$sel:resourceType:PutResourceConfig' :: PutResourceConfig -> Text
$sel:tags:PutResourceConfig' :: PutResourceConfig -> Maybe (HashMap Text Text)
$sel:resourceName:PutResourceConfig' :: PutResourceConfig -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
resourceName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe (HashMap Text Text)
tags
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
resourceType
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
schemaVersionId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
resourceId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
configuration

instance Data.ToHeaders PutResourceConfig where
  toHeaders :: PutResourceConfig -> [Header]
toHeaders =
    forall a b. a -> b -> a
Prelude.const
      ( forall a. Monoid a => [a] -> a
Prelude.mconcat
          [ HeaderName
"X-Amz-Target"
              forall a. ToHeader a => HeaderName -> a -> [Header]
Data.=# ( ByteString
"StarlingDoveService.PutResourceConfig" ::
                          Prelude.ByteString
                      ),
            HeaderName
"Content-Type"
              forall a. ToHeader a => HeaderName -> a -> [Header]
Data.=# ( ByteString
"application/x-amz-json-1.1" ::
                          Prelude.ByteString
                      )
          ]
      )

instance Data.ToJSON PutResourceConfig where
  toJSON :: PutResourceConfig -> Value
toJSON PutResourceConfig' {Maybe Text
Maybe (HashMap Text Text)
Text
configuration :: Text
resourceId :: Text
schemaVersionId :: Text
resourceType :: Text
tags :: Maybe (HashMap Text Text)
resourceName :: Maybe Text
$sel:configuration:PutResourceConfig' :: PutResourceConfig -> Text
$sel:resourceId:PutResourceConfig' :: PutResourceConfig -> Text
$sel:schemaVersionId:PutResourceConfig' :: PutResourceConfig -> Text
$sel:resourceType:PutResourceConfig' :: PutResourceConfig -> Text
$sel:tags:PutResourceConfig' :: PutResourceConfig -> Maybe (HashMap Text Text)
$sel:resourceName:PutResourceConfig' :: PutResourceConfig -> Maybe Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"ResourceName" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe Text
resourceName,
            (Key
"Tags" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe (HashMap Text Text)
tags,
            forall a. a -> Maybe a
Prelude.Just (Key
"ResourceType" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
resourceType),
            forall a. a -> Maybe a
Prelude.Just
              (Key
"SchemaVersionId" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
schemaVersionId),
            forall a. a -> Maybe a
Prelude.Just (Key
"ResourceId" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
resourceId),
            forall a. a -> Maybe a
Prelude.Just
              (Key
"Configuration" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
configuration)
          ]
      )

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

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

-- | /See:/ 'newPutResourceConfigResponse' smart constructor.
data PutResourceConfigResponse = PutResourceConfigResponse'
  {
  }
  deriving (PutResourceConfigResponse -> PutResourceConfigResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PutResourceConfigResponse -> PutResourceConfigResponse -> Bool
$c/= :: PutResourceConfigResponse -> PutResourceConfigResponse -> Bool
== :: PutResourceConfigResponse -> PutResourceConfigResponse -> Bool
$c== :: PutResourceConfigResponse -> PutResourceConfigResponse -> Bool
Prelude.Eq, ReadPrec [PutResourceConfigResponse]
ReadPrec PutResourceConfigResponse
Int -> ReadS PutResourceConfigResponse
ReadS [PutResourceConfigResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [PutResourceConfigResponse]
$creadListPrec :: ReadPrec [PutResourceConfigResponse]
readPrec :: ReadPrec PutResourceConfigResponse
$creadPrec :: ReadPrec PutResourceConfigResponse
readList :: ReadS [PutResourceConfigResponse]
$creadList :: ReadS [PutResourceConfigResponse]
readsPrec :: Int -> ReadS PutResourceConfigResponse
$creadsPrec :: Int -> ReadS PutResourceConfigResponse
Prelude.Read, Int -> PutResourceConfigResponse -> ShowS
[PutResourceConfigResponse] -> ShowS
PutResourceConfigResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PutResourceConfigResponse] -> ShowS
$cshowList :: [PutResourceConfigResponse] -> ShowS
show :: PutResourceConfigResponse -> String
$cshow :: PutResourceConfigResponse -> String
showsPrec :: Int -> PutResourceConfigResponse -> ShowS
$cshowsPrec :: Int -> PutResourceConfigResponse -> ShowS
Prelude.Show, forall x.
Rep PutResourceConfigResponse x -> PutResourceConfigResponse
forall x.
PutResourceConfigResponse -> Rep PutResourceConfigResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep PutResourceConfigResponse x -> PutResourceConfigResponse
$cfrom :: forall x.
PutResourceConfigResponse -> Rep PutResourceConfigResponse x
Prelude.Generic)

-- |
-- Create a value of 'PutResourceConfigResponse' 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.
newPutResourceConfigResponse ::
  PutResourceConfigResponse
newPutResourceConfigResponse :: PutResourceConfigResponse
newPutResourceConfigResponse =
  PutResourceConfigResponse
PutResourceConfigResponse'

instance Prelude.NFData PutResourceConfigResponse where
  rnf :: PutResourceConfigResponse -> ()
rnf PutResourceConfigResponse
_ = ()