{-# 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.ECS.PutAccountSetting
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Modifies an account setting. Account settings are set on a per-Region
-- basis.
--
-- If you change the account setting for the root user, the default
-- settings for all of the IAM users and roles that no individual account
-- setting was specified are reset for. For more information, see
-- <https://docs.aws.amazon.com/AmazonECS/latest/developerguide/ecs-account-settings.html Account Settings>
-- in the /Amazon Elastic Container Service Developer Guide/.
--
-- When @serviceLongArnFormat@, @taskLongArnFormat@, or
-- @containerInstanceLongArnFormat@ are specified, the Amazon Resource Name
-- (ARN) and resource ID format of the resource type for a specified IAM
-- user, IAM role, or the root user for an account is affected. The opt-in
-- and opt-out account setting must be set for each Amazon ECS resource
-- separately. The ARN and resource ID format of a resource is defined by
-- the opt-in status of the IAM user or role that created the resource. You
-- must turn on this setting to use Amazon ECS features such as resource
-- tagging.
--
-- When @awsvpcTrunking@ is specified, the elastic network interface (ENI)
-- limit for any new container instances that support the feature is
-- changed. If @awsvpcTrunking@ is enabled, any new container instances
-- that support the feature are launched have the increased ENI limits
-- available to them. For more information, see
-- <https://docs.aws.amazon.com/AmazonECS/latest/developerguide/container-instance-eni.html Elastic Network Interface Trunking>
-- in the /Amazon Elastic Container Service Developer Guide/.
--
-- When @containerInsights@ is specified, the default setting indicating
-- whether CloudWatch Container Insights is enabled for your clusters is
-- changed. If @containerInsights@ is enabled, any new clusters that are
-- created will have Container Insights enabled unless you disable it
-- during cluster creation. For more information, see
-- <https://docs.aws.amazon.com/AmazonECS/latest/developerguide/cloudwatch-container-insights.html CloudWatch Container Insights>
-- in the /Amazon Elastic Container Service Developer Guide/.
module Amazonka.ECS.PutAccountSetting
  ( -- * Creating a Request
    PutAccountSetting (..),
    newPutAccountSetting,

    -- * Request Lenses
    putAccountSetting_principalArn,
    putAccountSetting_name,
    putAccountSetting_value,

    -- * Destructuring the Response
    PutAccountSettingResponse (..),
    newPutAccountSettingResponse,

    -- * Response Lenses
    putAccountSettingResponse_setting,
    putAccountSettingResponse_httpStatus,
  )
where

import qualified Amazonka.Core as Core
import qualified Amazonka.Core.Lens.Internal as Lens
import qualified Amazonka.Data as Data
import Amazonka.ECS.Types
import qualified Amazonka.Prelude as Prelude
import qualified Amazonka.Request as Request
import qualified Amazonka.Response as Response

-- | /See:/ 'newPutAccountSetting' smart constructor.
data PutAccountSetting = PutAccountSetting'
  { -- | The ARN of the principal, which can be an IAM user, IAM role, or the
    -- root user. If you specify the root user, it modifies the account setting
    -- for all IAM users, IAM roles, and the root user of the account unless an
    -- IAM user or role explicitly overrides these settings. If this field is
    -- omitted, the setting is changed only for the authenticated user.
    --
    -- Federated users assume the account setting of the root user and can\'t
    -- have explicit account settings set for them.
    PutAccountSetting -> Maybe Text
principalArn :: Prelude.Maybe Prelude.Text,
    -- | The Amazon ECS resource name for which to modify the account setting. If
    -- @serviceLongArnFormat@ is specified, the ARN for your Amazon ECS
    -- services is affected. If @taskLongArnFormat@ is specified, the ARN and
    -- resource ID for your Amazon ECS tasks is affected. If
    -- @containerInstanceLongArnFormat@ is specified, the ARN and resource ID
    -- for your Amazon ECS container instances is affected. If @awsvpcTrunking@
    -- is specified, the elastic network interface (ENI) limit for your Amazon
    -- ECS container instances is affected. If @containerInsights@ is
    -- specified, the default setting for CloudWatch Container Insights for
    -- your clusters is affected.
    PutAccountSetting -> SettingName
name :: SettingName,
    -- | The account setting value for the specified principal ARN. Accepted
    -- values are @enabled@ and @disabled@.
    PutAccountSetting -> Text
value :: Prelude.Text
  }
  deriving (PutAccountSetting -> PutAccountSetting -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PutAccountSetting -> PutAccountSetting -> Bool
$c/= :: PutAccountSetting -> PutAccountSetting -> Bool
== :: PutAccountSetting -> PutAccountSetting -> Bool
$c== :: PutAccountSetting -> PutAccountSetting -> Bool
Prelude.Eq, ReadPrec [PutAccountSetting]
ReadPrec PutAccountSetting
Int -> ReadS PutAccountSetting
ReadS [PutAccountSetting]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [PutAccountSetting]
$creadListPrec :: ReadPrec [PutAccountSetting]
readPrec :: ReadPrec PutAccountSetting
$creadPrec :: ReadPrec PutAccountSetting
readList :: ReadS [PutAccountSetting]
$creadList :: ReadS [PutAccountSetting]
readsPrec :: Int -> ReadS PutAccountSetting
$creadsPrec :: Int -> ReadS PutAccountSetting
Prelude.Read, Int -> PutAccountSetting -> ShowS
[PutAccountSetting] -> ShowS
PutAccountSetting -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PutAccountSetting] -> ShowS
$cshowList :: [PutAccountSetting] -> ShowS
show :: PutAccountSetting -> String
$cshow :: PutAccountSetting -> String
showsPrec :: Int -> PutAccountSetting -> ShowS
$cshowsPrec :: Int -> PutAccountSetting -> ShowS
Prelude.Show, forall x. Rep PutAccountSetting x -> PutAccountSetting
forall x. PutAccountSetting -> Rep PutAccountSetting x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep PutAccountSetting x -> PutAccountSetting
$cfrom :: forall x. PutAccountSetting -> Rep PutAccountSetting x
Prelude.Generic)

-- |
-- Create a value of 'PutAccountSetting' 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:
--
-- 'principalArn', 'putAccountSetting_principalArn' - The ARN of the principal, which can be an IAM user, IAM role, or the
-- root user. If you specify the root user, it modifies the account setting
-- for all IAM users, IAM roles, and the root user of the account unless an
-- IAM user or role explicitly overrides these settings. If this field is
-- omitted, the setting is changed only for the authenticated user.
--
-- Federated users assume the account setting of the root user and can\'t
-- have explicit account settings set for them.
--
-- 'name', 'putAccountSetting_name' - The Amazon ECS resource name for which to modify the account setting. If
-- @serviceLongArnFormat@ is specified, the ARN for your Amazon ECS
-- services is affected. If @taskLongArnFormat@ is specified, the ARN and
-- resource ID for your Amazon ECS tasks is affected. If
-- @containerInstanceLongArnFormat@ is specified, the ARN and resource ID
-- for your Amazon ECS container instances is affected. If @awsvpcTrunking@
-- is specified, the elastic network interface (ENI) limit for your Amazon
-- ECS container instances is affected. If @containerInsights@ is
-- specified, the default setting for CloudWatch Container Insights for
-- your clusters is affected.
--
-- 'value', 'putAccountSetting_value' - The account setting value for the specified principal ARN. Accepted
-- values are @enabled@ and @disabled@.
newPutAccountSetting ::
  -- | 'name'
  SettingName ->
  -- | 'value'
  Prelude.Text ->
  PutAccountSetting
newPutAccountSetting :: SettingName -> Text -> PutAccountSetting
newPutAccountSetting SettingName
pName_ Text
pValue_ =
  PutAccountSetting'
    { $sel:principalArn:PutAccountSetting' :: Maybe Text
principalArn = forall a. Maybe a
Prelude.Nothing,
      $sel:name:PutAccountSetting' :: SettingName
name = SettingName
pName_,
      $sel:value:PutAccountSetting' :: Text
value = Text
pValue_
    }

-- | The ARN of the principal, which can be an IAM user, IAM role, or the
-- root user. If you specify the root user, it modifies the account setting
-- for all IAM users, IAM roles, and the root user of the account unless an
-- IAM user or role explicitly overrides these settings. If this field is
-- omitted, the setting is changed only for the authenticated user.
--
-- Federated users assume the account setting of the root user and can\'t
-- have explicit account settings set for them.
putAccountSetting_principalArn :: Lens.Lens' PutAccountSetting (Prelude.Maybe Prelude.Text)
putAccountSetting_principalArn :: Lens' PutAccountSetting (Maybe Text)
putAccountSetting_principalArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PutAccountSetting' {Maybe Text
principalArn :: Maybe Text
$sel:principalArn:PutAccountSetting' :: PutAccountSetting -> Maybe Text
principalArn} -> Maybe Text
principalArn) (\s :: PutAccountSetting
s@PutAccountSetting' {} Maybe Text
a -> PutAccountSetting
s {$sel:principalArn:PutAccountSetting' :: Maybe Text
principalArn = Maybe Text
a} :: PutAccountSetting)

-- | The Amazon ECS resource name for which to modify the account setting. If
-- @serviceLongArnFormat@ is specified, the ARN for your Amazon ECS
-- services is affected. If @taskLongArnFormat@ is specified, the ARN and
-- resource ID for your Amazon ECS tasks is affected. If
-- @containerInstanceLongArnFormat@ is specified, the ARN and resource ID
-- for your Amazon ECS container instances is affected. If @awsvpcTrunking@
-- is specified, the elastic network interface (ENI) limit for your Amazon
-- ECS container instances is affected. If @containerInsights@ is
-- specified, the default setting for CloudWatch Container Insights for
-- your clusters is affected.
putAccountSetting_name :: Lens.Lens' PutAccountSetting SettingName
putAccountSetting_name :: Lens' PutAccountSetting SettingName
putAccountSetting_name = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PutAccountSetting' {SettingName
name :: SettingName
$sel:name:PutAccountSetting' :: PutAccountSetting -> SettingName
name} -> SettingName
name) (\s :: PutAccountSetting
s@PutAccountSetting' {} SettingName
a -> PutAccountSetting
s {$sel:name:PutAccountSetting' :: SettingName
name = SettingName
a} :: PutAccountSetting)

-- | The account setting value for the specified principal ARN. Accepted
-- values are @enabled@ and @disabled@.
putAccountSetting_value :: Lens.Lens' PutAccountSetting Prelude.Text
putAccountSetting_value :: Lens' PutAccountSetting Text
putAccountSetting_value = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PutAccountSetting' {Text
value :: Text
$sel:value:PutAccountSetting' :: PutAccountSetting -> Text
value} -> Text
value) (\s :: PutAccountSetting
s@PutAccountSetting' {} Text
a -> PutAccountSetting
s {$sel:value:PutAccountSetting' :: Text
value = Text
a} :: PutAccountSetting)

instance Core.AWSRequest PutAccountSetting where
  type
    AWSResponse PutAccountSetting =
      PutAccountSettingResponse
  request :: (Service -> Service)
-> PutAccountSetting -> Request PutAccountSetting
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 PutAccountSetting
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse PutAccountSetting)))
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 Setting -> Int -> PutAccountSettingResponse
PutAccountSettingResponse'
            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
"setting")
            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 PutAccountSetting where
  hashWithSalt :: Int -> PutAccountSetting -> Int
hashWithSalt Int
_salt PutAccountSetting' {Maybe Text
Text
SettingName
value :: Text
name :: SettingName
principalArn :: Maybe Text
$sel:value:PutAccountSetting' :: PutAccountSetting -> Text
$sel:name:PutAccountSetting' :: PutAccountSetting -> SettingName
$sel:principalArn:PutAccountSetting' :: PutAccountSetting -> Maybe Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
principalArn
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` SettingName
name
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
value

instance Prelude.NFData PutAccountSetting where
  rnf :: PutAccountSetting -> ()
rnf PutAccountSetting' {Maybe Text
Text
SettingName
value :: Text
name :: SettingName
principalArn :: Maybe Text
$sel:value:PutAccountSetting' :: PutAccountSetting -> Text
$sel:name:PutAccountSetting' :: PutAccountSetting -> SettingName
$sel:principalArn:PutAccountSetting' :: PutAccountSetting -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
principalArn
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf SettingName
name
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
value

instance Data.ToHeaders PutAccountSetting where
  toHeaders :: PutAccountSetting -> 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
"AmazonEC2ContainerServiceV20141113.PutAccountSetting" ::
                          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 PutAccountSetting where
  toJSON :: PutAccountSetting -> Value
toJSON PutAccountSetting' {Maybe Text
Text
SettingName
value :: Text
name :: SettingName
principalArn :: Maybe Text
$sel:value:PutAccountSetting' :: PutAccountSetting -> Text
$sel:name:PutAccountSetting' :: PutAccountSetting -> SettingName
$sel:principalArn:PutAccountSetting' :: PutAccountSetting -> Maybe Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"principalArn" 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
principalArn,
            forall a. a -> Maybe a
Prelude.Just (Key
"name" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= SettingName
name),
            forall a. a -> Maybe a
Prelude.Just (Key
"value" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
value)
          ]
      )

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

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

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

-- |
-- Create a value of 'PutAccountSettingResponse' 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:
--
-- 'setting', 'putAccountSettingResponse_setting' - The current account setting for a resource.
--
-- 'httpStatus', 'putAccountSettingResponse_httpStatus' - The response's http status code.
newPutAccountSettingResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  PutAccountSettingResponse
newPutAccountSettingResponse :: Int -> PutAccountSettingResponse
newPutAccountSettingResponse Int
pHttpStatus_ =
  PutAccountSettingResponse'
    { $sel:setting:PutAccountSettingResponse' :: Maybe Setting
setting =
        forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:PutAccountSettingResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | The current account setting for a resource.
putAccountSettingResponse_setting :: Lens.Lens' PutAccountSettingResponse (Prelude.Maybe Setting)
putAccountSettingResponse_setting :: Lens' PutAccountSettingResponse (Maybe Setting)
putAccountSettingResponse_setting = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PutAccountSettingResponse' {Maybe Setting
setting :: Maybe Setting
$sel:setting:PutAccountSettingResponse' :: PutAccountSettingResponse -> Maybe Setting
setting} -> Maybe Setting
setting) (\s :: PutAccountSettingResponse
s@PutAccountSettingResponse' {} Maybe Setting
a -> PutAccountSettingResponse
s {$sel:setting:PutAccountSettingResponse' :: Maybe Setting
setting = Maybe Setting
a} :: PutAccountSettingResponse)

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

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