{-# 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.PutConfigurationAggregator
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Creates and updates the configuration aggregator with the selected
-- source accounts and regions. The source account can be individual
-- account(s) or an organization.
--
-- @accountIds@ that are passed will be replaced with existing accounts. If
-- you want to add additional accounts into the aggregator, call
-- @DescribeConfigurationAggregators@ to get the previous accounts and then
-- append new ones.
--
-- Config should be enabled in source accounts and regions you want to
-- aggregate.
--
-- If your source type is an organization, you must be signed in to the
-- management account or a registered delegated administrator and all the
-- features must be enabled in your organization. If the caller is a
-- management account, Config calls @EnableAwsServiceAccess@ API to enable
-- integration between Config and Organizations. If the caller is a
-- registered delegated administrator, Config calls
-- @ListDelegatedAdministrators@ API to verify whether the caller is a
-- valid delegated administrator.
--
-- To register a delegated administrator, see
-- <https://docs.aws.amazon.com/config/latest/developerguide/set-up-aggregator-cli.html#register-a-delegated-administrator-cli Register a Delegated Administrator>
-- in the /Config developer guide/.
module Amazonka.Config.PutConfigurationAggregator
  ( -- * Creating a Request
    PutConfigurationAggregator (..),
    newPutConfigurationAggregator,

    -- * Request Lenses
    putConfigurationAggregator_accountAggregationSources,
    putConfigurationAggregator_organizationAggregationSource,
    putConfigurationAggregator_tags,
    putConfigurationAggregator_configurationAggregatorName,

    -- * Destructuring the Response
    PutConfigurationAggregatorResponse (..),
    newPutConfigurationAggregatorResponse,

    -- * Response Lenses
    putConfigurationAggregatorResponse_configurationAggregator,
    putConfigurationAggregatorResponse_httpStatus,
  )
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:/ 'newPutConfigurationAggregator' smart constructor.
data PutConfigurationAggregator = PutConfigurationAggregator'
  { -- | A list of AccountAggregationSource object.
    PutConfigurationAggregator -> Maybe [AccountAggregationSource]
accountAggregationSources :: Prelude.Maybe [AccountAggregationSource],
    -- | An OrganizationAggregationSource object.
    PutConfigurationAggregator -> Maybe OrganizationAggregationSource
organizationAggregationSource :: Prelude.Maybe OrganizationAggregationSource,
    -- | An array of tag object.
    PutConfigurationAggregator -> Maybe [Tag]
tags :: Prelude.Maybe [Tag],
    -- | The name of the configuration aggregator.
    PutConfigurationAggregator -> Text
configurationAggregatorName :: Prelude.Text
  }
  deriving (PutConfigurationAggregator -> PutConfigurationAggregator -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PutConfigurationAggregator -> PutConfigurationAggregator -> Bool
$c/= :: PutConfigurationAggregator -> PutConfigurationAggregator -> Bool
== :: PutConfigurationAggregator -> PutConfigurationAggregator -> Bool
$c== :: PutConfigurationAggregator -> PutConfigurationAggregator -> Bool
Prelude.Eq, ReadPrec [PutConfigurationAggregator]
ReadPrec PutConfigurationAggregator
Int -> ReadS PutConfigurationAggregator
ReadS [PutConfigurationAggregator]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [PutConfigurationAggregator]
$creadListPrec :: ReadPrec [PutConfigurationAggregator]
readPrec :: ReadPrec PutConfigurationAggregator
$creadPrec :: ReadPrec PutConfigurationAggregator
readList :: ReadS [PutConfigurationAggregator]
$creadList :: ReadS [PutConfigurationAggregator]
readsPrec :: Int -> ReadS PutConfigurationAggregator
$creadsPrec :: Int -> ReadS PutConfigurationAggregator
Prelude.Read, Int -> PutConfigurationAggregator -> ShowS
[PutConfigurationAggregator] -> ShowS
PutConfigurationAggregator -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PutConfigurationAggregator] -> ShowS
$cshowList :: [PutConfigurationAggregator] -> ShowS
show :: PutConfigurationAggregator -> String
$cshow :: PutConfigurationAggregator -> String
showsPrec :: Int -> PutConfigurationAggregator -> ShowS
$cshowsPrec :: Int -> PutConfigurationAggregator -> ShowS
Prelude.Show, forall x.
Rep PutConfigurationAggregator x -> PutConfigurationAggregator
forall x.
PutConfigurationAggregator -> Rep PutConfigurationAggregator x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep PutConfigurationAggregator x -> PutConfigurationAggregator
$cfrom :: forall x.
PutConfigurationAggregator -> Rep PutConfigurationAggregator x
Prelude.Generic)

-- |
-- Create a value of 'PutConfigurationAggregator' 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:
--
-- 'accountAggregationSources', 'putConfigurationAggregator_accountAggregationSources' - A list of AccountAggregationSource object.
--
-- 'organizationAggregationSource', 'putConfigurationAggregator_organizationAggregationSource' - An OrganizationAggregationSource object.
--
-- 'tags', 'putConfigurationAggregator_tags' - An array of tag object.
--
-- 'configurationAggregatorName', 'putConfigurationAggregator_configurationAggregatorName' - The name of the configuration aggregator.
newPutConfigurationAggregator ::
  -- | 'configurationAggregatorName'
  Prelude.Text ->
  PutConfigurationAggregator
newPutConfigurationAggregator :: Text -> PutConfigurationAggregator
newPutConfigurationAggregator
  Text
pConfigurationAggregatorName_ =
    PutConfigurationAggregator'
      { $sel:accountAggregationSources:PutConfigurationAggregator' :: Maybe [AccountAggregationSource]
accountAggregationSources =
          forall a. Maybe a
Prelude.Nothing,
        $sel:organizationAggregationSource:PutConfigurationAggregator' :: Maybe OrganizationAggregationSource
organizationAggregationSource = forall a. Maybe a
Prelude.Nothing,
        $sel:tags:PutConfigurationAggregator' :: Maybe [Tag]
tags = forall a. Maybe a
Prelude.Nothing,
        $sel:configurationAggregatorName:PutConfigurationAggregator' :: Text
configurationAggregatorName =
          Text
pConfigurationAggregatorName_
      }

-- | A list of AccountAggregationSource object.
putConfigurationAggregator_accountAggregationSources :: Lens.Lens' PutConfigurationAggregator (Prelude.Maybe [AccountAggregationSource])
putConfigurationAggregator_accountAggregationSources :: Lens' PutConfigurationAggregator (Maybe [AccountAggregationSource])
putConfigurationAggregator_accountAggregationSources = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PutConfigurationAggregator' {Maybe [AccountAggregationSource]
accountAggregationSources :: Maybe [AccountAggregationSource]
$sel:accountAggregationSources:PutConfigurationAggregator' :: PutConfigurationAggregator -> Maybe [AccountAggregationSource]
accountAggregationSources} -> Maybe [AccountAggregationSource]
accountAggregationSources) (\s :: PutConfigurationAggregator
s@PutConfigurationAggregator' {} Maybe [AccountAggregationSource]
a -> PutConfigurationAggregator
s {$sel:accountAggregationSources:PutConfigurationAggregator' :: Maybe [AccountAggregationSource]
accountAggregationSources = Maybe [AccountAggregationSource]
a} :: PutConfigurationAggregator) 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

-- | An OrganizationAggregationSource object.
putConfigurationAggregator_organizationAggregationSource :: Lens.Lens' PutConfigurationAggregator (Prelude.Maybe OrganizationAggregationSource)
putConfigurationAggregator_organizationAggregationSource :: Lens'
  PutConfigurationAggregator (Maybe OrganizationAggregationSource)
putConfigurationAggregator_organizationAggregationSource = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PutConfigurationAggregator' {Maybe OrganizationAggregationSource
organizationAggregationSource :: Maybe OrganizationAggregationSource
$sel:organizationAggregationSource:PutConfigurationAggregator' :: PutConfigurationAggregator -> Maybe OrganizationAggregationSource
organizationAggregationSource} -> Maybe OrganizationAggregationSource
organizationAggregationSource) (\s :: PutConfigurationAggregator
s@PutConfigurationAggregator' {} Maybe OrganizationAggregationSource
a -> PutConfigurationAggregator
s {$sel:organizationAggregationSource:PutConfigurationAggregator' :: Maybe OrganizationAggregationSource
organizationAggregationSource = Maybe OrganizationAggregationSource
a} :: PutConfigurationAggregator)

-- | An array of tag object.
putConfigurationAggregator_tags :: Lens.Lens' PutConfigurationAggregator (Prelude.Maybe [Tag])
putConfigurationAggregator_tags :: Lens' PutConfigurationAggregator (Maybe [Tag])
putConfigurationAggregator_tags = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PutConfigurationAggregator' {Maybe [Tag]
tags :: Maybe [Tag]
$sel:tags:PutConfigurationAggregator' :: PutConfigurationAggregator -> Maybe [Tag]
tags} -> Maybe [Tag]
tags) (\s :: PutConfigurationAggregator
s@PutConfigurationAggregator' {} Maybe [Tag]
a -> PutConfigurationAggregator
s {$sel:tags:PutConfigurationAggregator' :: Maybe [Tag]
tags = Maybe [Tag]
a} :: PutConfigurationAggregator) 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 name of the configuration aggregator.
putConfigurationAggregator_configurationAggregatorName :: Lens.Lens' PutConfigurationAggregator Prelude.Text
putConfigurationAggregator_configurationAggregatorName :: Lens' PutConfigurationAggregator Text
putConfigurationAggregator_configurationAggregatorName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PutConfigurationAggregator' {Text
configurationAggregatorName :: Text
$sel:configurationAggregatorName:PutConfigurationAggregator' :: PutConfigurationAggregator -> Text
configurationAggregatorName} -> Text
configurationAggregatorName) (\s :: PutConfigurationAggregator
s@PutConfigurationAggregator' {} Text
a -> PutConfigurationAggregator
s {$sel:configurationAggregatorName:PutConfigurationAggregator' :: Text
configurationAggregatorName = Text
a} :: PutConfigurationAggregator)

instance Core.AWSRequest PutConfigurationAggregator where
  type
    AWSResponse PutConfigurationAggregator =
      PutConfigurationAggregatorResponse
  request :: (Service -> Service)
-> PutConfigurationAggregator -> Request PutConfigurationAggregator
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 PutConfigurationAggregator
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse PutConfigurationAggregator)))
response =
    forall (m :: * -> *) a.
MonadResource m =>
(Int -> ResponseHeaders -> Object -> Either String (AWSResponse a))
-> (ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy a
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse a)))
Response.receiveJSON
      ( \Int
s ResponseHeaders
h Object
x ->
          Maybe ConfigurationAggregator
-> Int -> PutConfigurationAggregatorResponse
PutConfigurationAggregatorResponse'
            forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"ConfigurationAggregator")
            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 PutConfigurationAggregator where
  hashWithSalt :: Int -> PutConfigurationAggregator -> Int
hashWithSalt Int
_salt PutConfigurationAggregator' {Maybe [AccountAggregationSource]
Maybe [Tag]
Maybe OrganizationAggregationSource
Text
configurationAggregatorName :: Text
tags :: Maybe [Tag]
organizationAggregationSource :: Maybe OrganizationAggregationSource
accountAggregationSources :: Maybe [AccountAggregationSource]
$sel:configurationAggregatorName:PutConfigurationAggregator' :: PutConfigurationAggregator -> Text
$sel:tags:PutConfigurationAggregator' :: PutConfigurationAggregator -> Maybe [Tag]
$sel:organizationAggregationSource:PutConfigurationAggregator' :: PutConfigurationAggregator -> Maybe OrganizationAggregationSource
$sel:accountAggregationSources:PutConfigurationAggregator' :: PutConfigurationAggregator -> Maybe [AccountAggregationSource]
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [AccountAggregationSource]
accountAggregationSources
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe OrganizationAggregationSource
organizationAggregationSource
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [Tag]
tags
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
configurationAggregatorName

instance Prelude.NFData PutConfigurationAggregator where
  rnf :: PutConfigurationAggregator -> ()
rnf PutConfigurationAggregator' {Maybe [AccountAggregationSource]
Maybe [Tag]
Maybe OrganizationAggregationSource
Text
configurationAggregatorName :: Text
tags :: Maybe [Tag]
organizationAggregationSource :: Maybe OrganizationAggregationSource
accountAggregationSources :: Maybe [AccountAggregationSource]
$sel:configurationAggregatorName:PutConfigurationAggregator' :: PutConfigurationAggregator -> Text
$sel:tags:PutConfigurationAggregator' :: PutConfigurationAggregator -> Maybe [Tag]
$sel:organizationAggregationSource:PutConfigurationAggregator' :: PutConfigurationAggregator -> Maybe OrganizationAggregationSource
$sel:accountAggregationSources:PutConfigurationAggregator' :: PutConfigurationAggregator -> Maybe [AccountAggregationSource]
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe [AccountAggregationSource]
accountAggregationSources
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe OrganizationAggregationSource
organizationAggregationSource
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [Tag]
tags
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
configurationAggregatorName

instance Data.ToHeaders PutConfigurationAggregator where
  toHeaders :: PutConfigurationAggregator -> ResponseHeaders
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 -> ResponseHeaders
Data.=# ( ByteString
"StarlingDoveService.PutConfigurationAggregator" ::
                          Prelude.ByteString
                      ),
            HeaderName
"Content-Type"
              forall a. ToHeader a => HeaderName -> a -> ResponseHeaders
Data.=# ( ByteString
"application/x-amz-json-1.1" ::
                          Prelude.ByteString
                      )
          ]
      )

instance Data.ToJSON PutConfigurationAggregator where
  toJSON :: PutConfigurationAggregator -> Value
toJSON PutConfigurationAggregator' {Maybe [AccountAggregationSource]
Maybe [Tag]
Maybe OrganizationAggregationSource
Text
configurationAggregatorName :: Text
tags :: Maybe [Tag]
organizationAggregationSource :: Maybe OrganizationAggregationSource
accountAggregationSources :: Maybe [AccountAggregationSource]
$sel:configurationAggregatorName:PutConfigurationAggregator' :: PutConfigurationAggregator -> Text
$sel:tags:PutConfigurationAggregator' :: PutConfigurationAggregator -> Maybe [Tag]
$sel:organizationAggregationSource:PutConfigurationAggregator' :: PutConfigurationAggregator -> Maybe OrganizationAggregationSource
$sel:accountAggregationSources:PutConfigurationAggregator' :: PutConfigurationAggregator -> Maybe [AccountAggregationSource]
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"AccountAggregationSources" 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 [AccountAggregationSource]
accountAggregationSources,
            (Key
"OrganizationAggregationSource" 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 OrganizationAggregationSource
organizationAggregationSource,
            (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 [Tag]
tags,
            forall a. a -> Maybe a
Prelude.Just
              ( Key
"ConfigurationAggregatorName"
                  forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
configurationAggregatorName
              )
          ]
      )

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

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

-- | /See:/ 'newPutConfigurationAggregatorResponse' smart constructor.
data PutConfigurationAggregatorResponse = PutConfigurationAggregatorResponse'
  { -- | Returns a ConfigurationAggregator object.
    PutConfigurationAggregatorResponse -> Maybe ConfigurationAggregator
configurationAggregator :: Prelude.Maybe ConfigurationAggregator,
    -- | The response's http status code.
    PutConfigurationAggregatorResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (PutConfigurationAggregatorResponse
-> PutConfigurationAggregatorResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PutConfigurationAggregatorResponse
-> PutConfigurationAggregatorResponse -> Bool
$c/= :: PutConfigurationAggregatorResponse
-> PutConfigurationAggregatorResponse -> Bool
== :: PutConfigurationAggregatorResponse
-> PutConfigurationAggregatorResponse -> Bool
$c== :: PutConfigurationAggregatorResponse
-> PutConfigurationAggregatorResponse -> Bool
Prelude.Eq, ReadPrec [PutConfigurationAggregatorResponse]
ReadPrec PutConfigurationAggregatorResponse
Int -> ReadS PutConfigurationAggregatorResponse
ReadS [PutConfigurationAggregatorResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [PutConfigurationAggregatorResponse]
$creadListPrec :: ReadPrec [PutConfigurationAggregatorResponse]
readPrec :: ReadPrec PutConfigurationAggregatorResponse
$creadPrec :: ReadPrec PutConfigurationAggregatorResponse
readList :: ReadS [PutConfigurationAggregatorResponse]
$creadList :: ReadS [PutConfigurationAggregatorResponse]
readsPrec :: Int -> ReadS PutConfigurationAggregatorResponse
$creadsPrec :: Int -> ReadS PutConfigurationAggregatorResponse
Prelude.Read, Int -> PutConfigurationAggregatorResponse -> ShowS
[PutConfigurationAggregatorResponse] -> ShowS
PutConfigurationAggregatorResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PutConfigurationAggregatorResponse] -> ShowS
$cshowList :: [PutConfigurationAggregatorResponse] -> ShowS
show :: PutConfigurationAggregatorResponse -> String
$cshow :: PutConfigurationAggregatorResponse -> String
showsPrec :: Int -> PutConfigurationAggregatorResponse -> ShowS
$cshowsPrec :: Int -> PutConfigurationAggregatorResponse -> ShowS
Prelude.Show, forall x.
Rep PutConfigurationAggregatorResponse x
-> PutConfigurationAggregatorResponse
forall x.
PutConfigurationAggregatorResponse
-> Rep PutConfigurationAggregatorResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep PutConfigurationAggregatorResponse x
-> PutConfigurationAggregatorResponse
$cfrom :: forall x.
PutConfigurationAggregatorResponse
-> Rep PutConfigurationAggregatorResponse x
Prelude.Generic)

-- |
-- Create a value of 'PutConfigurationAggregatorResponse' 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:
--
-- 'configurationAggregator', 'putConfigurationAggregatorResponse_configurationAggregator' - Returns a ConfigurationAggregator object.
--
-- 'httpStatus', 'putConfigurationAggregatorResponse_httpStatus' - The response's http status code.
newPutConfigurationAggregatorResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  PutConfigurationAggregatorResponse
newPutConfigurationAggregatorResponse :: Int -> PutConfigurationAggregatorResponse
newPutConfigurationAggregatorResponse Int
pHttpStatus_ =
  PutConfigurationAggregatorResponse'
    { $sel:configurationAggregator:PutConfigurationAggregatorResponse' :: Maybe ConfigurationAggregator
configurationAggregator =
        forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:PutConfigurationAggregatorResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | Returns a ConfigurationAggregator object.
putConfigurationAggregatorResponse_configurationAggregator :: Lens.Lens' PutConfigurationAggregatorResponse (Prelude.Maybe ConfigurationAggregator)
putConfigurationAggregatorResponse_configurationAggregator :: Lens'
  PutConfigurationAggregatorResponse (Maybe ConfigurationAggregator)
putConfigurationAggregatorResponse_configurationAggregator = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PutConfigurationAggregatorResponse' {Maybe ConfigurationAggregator
configurationAggregator :: Maybe ConfigurationAggregator
$sel:configurationAggregator:PutConfigurationAggregatorResponse' :: PutConfigurationAggregatorResponse -> Maybe ConfigurationAggregator
configurationAggregator} -> Maybe ConfigurationAggregator
configurationAggregator) (\s :: PutConfigurationAggregatorResponse
s@PutConfigurationAggregatorResponse' {} Maybe ConfigurationAggregator
a -> PutConfigurationAggregatorResponse
s {$sel:configurationAggregator:PutConfigurationAggregatorResponse' :: Maybe ConfigurationAggregator
configurationAggregator = Maybe ConfigurationAggregator
a} :: PutConfigurationAggregatorResponse)

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

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