{-# 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.Proton.UpdateAccountSettings
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Update Proton settings that are used for multiple services in the Amazon
-- Web Services account.
module Amazonka.Proton.UpdateAccountSettings
  ( -- * Creating a Request
    UpdateAccountSettings (..),
    newUpdateAccountSettings,

    -- * Request Lenses
    updateAccountSettings_deletePipelineProvisioningRepository,
    updateAccountSettings_pipelineCodebuildRoleArn,
    updateAccountSettings_pipelineProvisioningRepository,
    updateAccountSettings_pipelineServiceRoleArn,

    -- * Destructuring the Response
    UpdateAccountSettingsResponse (..),
    newUpdateAccountSettingsResponse,

    -- * Response Lenses
    updateAccountSettingsResponse_httpStatus,
    updateAccountSettingsResponse_accountSettings,
  )
where

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 Amazonka.Proton.Types
import qualified Amazonka.Request as Request
import qualified Amazonka.Response as Response

-- | /See:/ 'newUpdateAccountSettings' smart constructor.
data UpdateAccountSettings = UpdateAccountSettings'
  { -- | Set to @true@ to remove a configured pipeline repository from the
    -- account settings. Don\'t set this field if you are updating the
    -- configured pipeline repository.
    UpdateAccountSettings -> Maybe Bool
deletePipelineProvisioningRepository :: Prelude.Maybe Prelude.Bool,
    -- | The Amazon Resource Name (ARN) of the service role you want to use for
    -- provisioning pipelines. Proton assumes this role for CodeBuild-based
    -- provisioning.
    UpdateAccountSettings -> Maybe Text
pipelineCodebuildRoleArn :: Prelude.Maybe Prelude.Text,
    -- | A linked repository for pipeline provisioning. Specify it if you have
    -- environments configured for self-managed provisioning with services that
    -- include pipelines. A linked repository is a repository that has been
    -- registered with Proton. For more information, see CreateRepository.
    --
    -- To remove a previously configured repository, set
    -- @deletePipelineProvisioningRepository@ to @true@, and don\'t set
    -- @pipelineProvisioningRepository@.
    UpdateAccountSettings -> Maybe RepositoryBranchInput
pipelineProvisioningRepository :: Prelude.Maybe RepositoryBranchInput,
    -- | The Amazon Resource Name (ARN) of the service role you want to use for
    -- provisioning pipelines. Assumed by Proton for Amazon Web
    -- Services-managed provisioning, and by customer-owned automation for
    -- self-managed provisioning.
    --
    -- To remove a previously configured ARN, specify an empty string.
    UpdateAccountSettings -> Maybe Text
pipelineServiceRoleArn :: Prelude.Maybe Prelude.Text
  }
  deriving (UpdateAccountSettings -> UpdateAccountSettings -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UpdateAccountSettings -> UpdateAccountSettings -> Bool
$c/= :: UpdateAccountSettings -> UpdateAccountSettings -> Bool
== :: UpdateAccountSettings -> UpdateAccountSettings -> Bool
$c== :: UpdateAccountSettings -> UpdateAccountSettings -> Bool
Prelude.Eq, ReadPrec [UpdateAccountSettings]
ReadPrec UpdateAccountSettings
Int -> ReadS UpdateAccountSettings
ReadS [UpdateAccountSettings]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [UpdateAccountSettings]
$creadListPrec :: ReadPrec [UpdateAccountSettings]
readPrec :: ReadPrec UpdateAccountSettings
$creadPrec :: ReadPrec UpdateAccountSettings
readList :: ReadS [UpdateAccountSettings]
$creadList :: ReadS [UpdateAccountSettings]
readsPrec :: Int -> ReadS UpdateAccountSettings
$creadsPrec :: Int -> ReadS UpdateAccountSettings
Prelude.Read, Int -> UpdateAccountSettings -> ShowS
[UpdateAccountSettings] -> ShowS
UpdateAccountSettings -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UpdateAccountSettings] -> ShowS
$cshowList :: [UpdateAccountSettings] -> ShowS
show :: UpdateAccountSettings -> String
$cshow :: UpdateAccountSettings -> String
showsPrec :: Int -> UpdateAccountSettings -> ShowS
$cshowsPrec :: Int -> UpdateAccountSettings -> ShowS
Prelude.Show, forall x. Rep UpdateAccountSettings x -> UpdateAccountSettings
forall x. UpdateAccountSettings -> Rep UpdateAccountSettings x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep UpdateAccountSettings x -> UpdateAccountSettings
$cfrom :: forall x. UpdateAccountSettings -> Rep UpdateAccountSettings x
Prelude.Generic)

-- |
-- Create a value of 'UpdateAccountSettings' 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:
--
-- 'deletePipelineProvisioningRepository', 'updateAccountSettings_deletePipelineProvisioningRepository' - Set to @true@ to remove a configured pipeline repository from the
-- account settings. Don\'t set this field if you are updating the
-- configured pipeline repository.
--
-- 'pipelineCodebuildRoleArn', 'updateAccountSettings_pipelineCodebuildRoleArn' - The Amazon Resource Name (ARN) of the service role you want to use for
-- provisioning pipelines. Proton assumes this role for CodeBuild-based
-- provisioning.
--
-- 'pipelineProvisioningRepository', 'updateAccountSettings_pipelineProvisioningRepository' - A linked repository for pipeline provisioning. Specify it if you have
-- environments configured for self-managed provisioning with services that
-- include pipelines. A linked repository is a repository that has been
-- registered with Proton. For more information, see CreateRepository.
--
-- To remove a previously configured repository, set
-- @deletePipelineProvisioningRepository@ to @true@, and don\'t set
-- @pipelineProvisioningRepository@.
--
-- 'pipelineServiceRoleArn', 'updateAccountSettings_pipelineServiceRoleArn' - The Amazon Resource Name (ARN) of the service role you want to use for
-- provisioning pipelines. Assumed by Proton for Amazon Web
-- Services-managed provisioning, and by customer-owned automation for
-- self-managed provisioning.
--
-- To remove a previously configured ARN, specify an empty string.
newUpdateAccountSettings ::
  UpdateAccountSettings
newUpdateAccountSettings :: UpdateAccountSettings
newUpdateAccountSettings =
  UpdateAccountSettings'
    { $sel:deletePipelineProvisioningRepository:UpdateAccountSettings' :: Maybe Bool
deletePipelineProvisioningRepository =
        forall a. Maybe a
Prelude.Nothing,
      $sel:pipelineCodebuildRoleArn:UpdateAccountSettings' :: Maybe Text
pipelineCodebuildRoleArn = forall a. Maybe a
Prelude.Nothing,
      $sel:pipelineProvisioningRepository:UpdateAccountSettings' :: Maybe RepositoryBranchInput
pipelineProvisioningRepository = forall a. Maybe a
Prelude.Nothing,
      $sel:pipelineServiceRoleArn:UpdateAccountSettings' :: Maybe Text
pipelineServiceRoleArn = forall a. Maybe a
Prelude.Nothing
    }

-- | Set to @true@ to remove a configured pipeline repository from the
-- account settings. Don\'t set this field if you are updating the
-- configured pipeline repository.
updateAccountSettings_deletePipelineProvisioningRepository :: Lens.Lens' UpdateAccountSettings (Prelude.Maybe Prelude.Bool)
updateAccountSettings_deletePipelineProvisioningRepository :: Lens' UpdateAccountSettings (Maybe Bool)
updateAccountSettings_deletePipelineProvisioningRepository = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateAccountSettings' {Maybe Bool
deletePipelineProvisioningRepository :: Maybe Bool
$sel:deletePipelineProvisioningRepository:UpdateAccountSettings' :: UpdateAccountSettings -> Maybe Bool
deletePipelineProvisioningRepository} -> Maybe Bool
deletePipelineProvisioningRepository) (\s :: UpdateAccountSettings
s@UpdateAccountSettings' {} Maybe Bool
a -> UpdateAccountSettings
s {$sel:deletePipelineProvisioningRepository:UpdateAccountSettings' :: Maybe Bool
deletePipelineProvisioningRepository = Maybe Bool
a} :: UpdateAccountSettings)

-- | The Amazon Resource Name (ARN) of the service role you want to use for
-- provisioning pipelines. Proton assumes this role for CodeBuild-based
-- provisioning.
updateAccountSettings_pipelineCodebuildRoleArn :: Lens.Lens' UpdateAccountSettings (Prelude.Maybe Prelude.Text)
updateAccountSettings_pipelineCodebuildRoleArn :: Lens' UpdateAccountSettings (Maybe Text)
updateAccountSettings_pipelineCodebuildRoleArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateAccountSettings' {Maybe Text
pipelineCodebuildRoleArn :: Maybe Text
$sel:pipelineCodebuildRoleArn:UpdateAccountSettings' :: UpdateAccountSettings -> Maybe Text
pipelineCodebuildRoleArn} -> Maybe Text
pipelineCodebuildRoleArn) (\s :: UpdateAccountSettings
s@UpdateAccountSettings' {} Maybe Text
a -> UpdateAccountSettings
s {$sel:pipelineCodebuildRoleArn:UpdateAccountSettings' :: Maybe Text
pipelineCodebuildRoleArn = Maybe Text
a} :: UpdateAccountSettings)

-- | A linked repository for pipeline provisioning. Specify it if you have
-- environments configured for self-managed provisioning with services that
-- include pipelines. A linked repository is a repository that has been
-- registered with Proton. For more information, see CreateRepository.
--
-- To remove a previously configured repository, set
-- @deletePipelineProvisioningRepository@ to @true@, and don\'t set
-- @pipelineProvisioningRepository@.
updateAccountSettings_pipelineProvisioningRepository :: Lens.Lens' UpdateAccountSettings (Prelude.Maybe RepositoryBranchInput)
updateAccountSettings_pipelineProvisioningRepository :: Lens' UpdateAccountSettings (Maybe RepositoryBranchInput)
updateAccountSettings_pipelineProvisioningRepository = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateAccountSettings' {Maybe RepositoryBranchInput
pipelineProvisioningRepository :: Maybe RepositoryBranchInput
$sel:pipelineProvisioningRepository:UpdateAccountSettings' :: UpdateAccountSettings -> Maybe RepositoryBranchInput
pipelineProvisioningRepository} -> Maybe RepositoryBranchInput
pipelineProvisioningRepository) (\s :: UpdateAccountSettings
s@UpdateAccountSettings' {} Maybe RepositoryBranchInput
a -> UpdateAccountSettings
s {$sel:pipelineProvisioningRepository:UpdateAccountSettings' :: Maybe RepositoryBranchInput
pipelineProvisioningRepository = Maybe RepositoryBranchInput
a} :: UpdateAccountSettings)

-- | The Amazon Resource Name (ARN) of the service role you want to use for
-- provisioning pipelines. Assumed by Proton for Amazon Web
-- Services-managed provisioning, and by customer-owned automation for
-- self-managed provisioning.
--
-- To remove a previously configured ARN, specify an empty string.
updateAccountSettings_pipelineServiceRoleArn :: Lens.Lens' UpdateAccountSettings (Prelude.Maybe Prelude.Text)
updateAccountSettings_pipelineServiceRoleArn :: Lens' UpdateAccountSettings (Maybe Text)
updateAccountSettings_pipelineServiceRoleArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateAccountSettings' {Maybe Text
pipelineServiceRoleArn :: Maybe Text
$sel:pipelineServiceRoleArn:UpdateAccountSettings' :: UpdateAccountSettings -> Maybe Text
pipelineServiceRoleArn} -> Maybe Text
pipelineServiceRoleArn) (\s :: UpdateAccountSettings
s@UpdateAccountSettings' {} Maybe Text
a -> UpdateAccountSettings
s {$sel:pipelineServiceRoleArn:UpdateAccountSettings' :: Maybe Text
pipelineServiceRoleArn = Maybe Text
a} :: UpdateAccountSettings)

instance Core.AWSRequest UpdateAccountSettings where
  type
    AWSResponse UpdateAccountSettings =
      UpdateAccountSettingsResponse
  request :: (Service -> Service)
-> UpdateAccountSettings -> Request UpdateAccountSettings
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 UpdateAccountSettings
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse UpdateAccountSettings)))
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 ->
          Int -> AccountSettings -> UpdateAccountSettingsResponse
UpdateAccountSettingsResponse'
            forall (f :: * -> *) a b. Functor 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))
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String a
Data..:> Key
"accountSettings")
      )

instance Prelude.Hashable UpdateAccountSettings where
  hashWithSalt :: Int -> UpdateAccountSettings -> Int
hashWithSalt Int
_salt UpdateAccountSettings' {Maybe Bool
Maybe Text
Maybe RepositoryBranchInput
pipelineServiceRoleArn :: Maybe Text
pipelineProvisioningRepository :: Maybe RepositoryBranchInput
pipelineCodebuildRoleArn :: Maybe Text
deletePipelineProvisioningRepository :: Maybe Bool
$sel:pipelineServiceRoleArn:UpdateAccountSettings' :: UpdateAccountSettings -> Maybe Text
$sel:pipelineProvisioningRepository:UpdateAccountSettings' :: UpdateAccountSettings -> Maybe RepositoryBranchInput
$sel:pipelineCodebuildRoleArn:UpdateAccountSettings' :: UpdateAccountSettings -> Maybe Text
$sel:deletePipelineProvisioningRepository:UpdateAccountSettings' :: UpdateAccountSettings -> Maybe Bool
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Bool
deletePipelineProvisioningRepository
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
pipelineCodebuildRoleArn
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe RepositoryBranchInput
pipelineProvisioningRepository
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
pipelineServiceRoleArn

instance Prelude.NFData UpdateAccountSettings where
  rnf :: UpdateAccountSettings -> ()
rnf UpdateAccountSettings' {Maybe Bool
Maybe Text
Maybe RepositoryBranchInput
pipelineServiceRoleArn :: Maybe Text
pipelineProvisioningRepository :: Maybe RepositoryBranchInput
pipelineCodebuildRoleArn :: Maybe Text
deletePipelineProvisioningRepository :: Maybe Bool
$sel:pipelineServiceRoleArn:UpdateAccountSettings' :: UpdateAccountSettings -> Maybe Text
$sel:pipelineProvisioningRepository:UpdateAccountSettings' :: UpdateAccountSettings -> Maybe RepositoryBranchInput
$sel:pipelineCodebuildRoleArn:UpdateAccountSettings' :: UpdateAccountSettings -> Maybe Text
$sel:deletePipelineProvisioningRepository:UpdateAccountSettings' :: UpdateAccountSettings -> Maybe Bool
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Bool
deletePipelineProvisioningRepository
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
pipelineCodebuildRoleArn
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe RepositoryBranchInput
pipelineProvisioningRepository
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
pipelineServiceRoleArn

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

instance Data.ToJSON UpdateAccountSettings where
  toJSON :: UpdateAccountSettings -> Value
toJSON UpdateAccountSettings' {Maybe Bool
Maybe Text
Maybe RepositoryBranchInput
pipelineServiceRoleArn :: Maybe Text
pipelineProvisioningRepository :: Maybe RepositoryBranchInput
pipelineCodebuildRoleArn :: Maybe Text
deletePipelineProvisioningRepository :: Maybe Bool
$sel:pipelineServiceRoleArn:UpdateAccountSettings' :: UpdateAccountSettings -> Maybe Text
$sel:pipelineProvisioningRepository:UpdateAccountSettings' :: UpdateAccountSettings -> Maybe RepositoryBranchInput
$sel:pipelineCodebuildRoleArn:UpdateAccountSettings' :: UpdateAccountSettings -> Maybe Text
$sel:deletePipelineProvisioningRepository:UpdateAccountSettings' :: UpdateAccountSettings -> Maybe Bool
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"deletePipelineProvisioningRepository" 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 Bool
deletePipelineProvisioningRepository,
            (Key
"pipelineCodebuildRoleArn" 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
pipelineCodebuildRoleArn,
            (Key
"pipelineProvisioningRepository" 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 RepositoryBranchInput
pipelineProvisioningRepository,
            (Key
"pipelineServiceRoleArn" 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
pipelineServiceRoleArn
          ]
      )

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

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

-- | /See:/ 'newUpdateAccountSettingsResponse' smart constructor.
data UpdateAccountSettingsResponse = UpdateAccountSettingsResponse'
  { -- | The response's http status code.
    UpdateAccountSettingsResponse -> Int
httpStatus :: Prelude.Int,
    -- | The Proton pipeline service role and repository data shared across the
    -- Amazon Web Services account.
    UpdateAccountSettingsResponse -> AccountSettings
accountSettings :: AccountSettings
  }
  deriving (UpdateAccountSettingsResponse
-> UpdateAccountSettingsResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UpdateAccountSettingsResponse
-> UpdateAccountSettingsResponse -> Bool
$c/= :: UpdateAccountSettingsResponse
-> UpdateAccountSettingsResponse -> Bool
== :: UpdateAccountSettingsResponse
-> UpdateAccountSettingsResponse -> Bool
$c== :: UpdateAccountSettingsResponse
-> UpdateAccountSettingsResponse -> Bool
Prelude.Eq, ReadPrec [UpdateAccountSettingsResponse]
ReadPrec UpdateAccountSettingsResponse
Int -> ReadS UpdateAccountSettingsResponse
ReadS [UpdateAccountSettingsResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [UpdateAccountSettingsResponse]
$creadListPrec :: ReadPrec [UpdateAccountSettingsResponse]
readPrec :: ReadPrec UpdateAccountSettingsResponse
$creadPrec :: ReadPrec UpdateAccountSettingsResponse
readList :: ReadS [UpdateAccountSettingsResponse]
$creadList :: ReadS [UpdateAccountSettingsResponse]
readsPrec :: Int -> ReadS UpdateAccountSettingsResponse
$creadsPrec :: Int -> ReadS UpdateAccountSettingsResponse
Prelude.Read, Int -> UpdateAccountSettingsResponse -> ShowS
[UpdateAccountSettingsResponse] -> ShowS
UpdateAccountSettingsResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UpdateAccountSettingsResponse] -> ShowS
$cshowList :: [UpdateAccountSettingsResponse] -> ShowS
show :: UpdateAccountSettingsResponse -> String
$cshow :: UpdateAccountSettingsResponse -> String
showsPrec :: Int -> UpdateAccountSettingsResponse -> ShowS
$cshowsPrec :: Int -> UpdateAccountSettingsResponse -> ShowS
Prelude.Show, forall x.
Rep UpdateAccountSettingsResponse x
-> UpdateAccountSettingsResponse
forall x.
UpdateAccountSettingsResponse
-> Rep UpdateAccountSettingsResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep UpdateAccountSettingsResponse x
-> UpdateAccountSettingsResponse
$cfrom :: forall x.
UpdateAccountSettingsResponse
-> Rep UpdateAccountSettingsResponse x
Prelude.Generic)

-- |
-- Create a value of 'UpdateAccountSettingsResponse' 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:
--
-- 'httpStatus', 'updateAccountSettingsResponse_httpStatus' - The response's http status code.
--
-- 'accountSettings', 'updateAccountSettingsResponse_accountSettings' - The Proton pipeline service role and repository data shared across the
-- Amazon Web Services account.
newUpdateAccountSettingsResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  -- | 'accountSettings'
  AccountSettings ->
  UpdateAccountSettingsResponse
newUpdateAccountSettingsResponse :: Int -> AccountSettings -> UpdateAccountSettingsResponse
newUpdateAccountSettingsResponse
  Int
pHttpStatus_
  AccountSettings
pAccountSettings_ =
    UpdateAccountSettingsResponse'
      { $sel:httpStatus:UpdateAccountSettingsResponse' :: Int
httpStatus =
          Int
pHttpStatus_,
        $sel:accountSettings:UpdateAccountSettingsResponse' :: AccountSettings
accountSettings = AccountSettings
pAccountSettings_
      }

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

-- | The Proton pipeline service role and repository data shared across the
-- Amazon Web Services account.
updateAccountSettingsResponse_accountSettings :: Lens.Lens' UpdateAccountSettingsResponse AccountSettings
updateAccountSettingsResponse_accountSettings :: Lens' UpdateAccountSettingsResponse AccountSettings
updateAccountSettingsResponse_accountSettings = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateAccountSettingsResponse' {AccountSettings
accountSettings :: AccountSettings
$sel:accountSettings:UpdateAccountSettingsResponse' :: UpdateAccountSettingsResponse -> AccountSettings
accountSettings} -> AccountSettings
accountSettings) (\s :: UpdateAccountSettingsResponse
s@UpdateAccountSettingsResponse' {} AccountSettings
a -> UpdateAccountSettingsResponse
s {$sel:accountSettings:UpdateAccountSettingsResponse' :: AccountSettings
accountSettings = AccountSettings
a} :: UpdateAccountSettingsResponse)

instance Prelude.NFData UpdateAccountSettingsResponse where
  rnf :: UpdateAccountSettingsResponse -> ()
rnf UpdateAccountSettingsResponse' {Int
AccountSettings
accountSettings :: AccountSettings
httpStatus :: Int
$sel:accountSettings:UpdateAccountSettingsResponse' :: UpdateAccountSettingsResponse -> AccountSettings
$sel:httpStatus:UpdateAccountSettingsResponse' :: UpdateAccountSettingsResponse -> Int
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf AccountSettings
accountSettings