{-# 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.PutAccountSettingDefault
-- 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 for all IAM users on an account for whom no
-- individual account setting has been specified. Account settings are set
-- on a per-Region basis.
module Amazonka.ECS.PutAccountSettingDefault
  ( -- * Creating a Request
    PutAccountSettingDefault (..),
    newPutAccountSettingDefault,

    -- * Request Lenses
    putAccountSettingDefault_name,
    putAccountSettingDefault_value,

    -- * Destructuring the Response
    PutAccountSettingDefaultResponse (..),
    newPutAccountSettingDefaultResponse,

    -- * Response Lenses
    putAccountSettingDefaultResponse_setting,
    putAccountSettingDefaultResponse_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:/ 'newPutAccountSettingDefault' smart constructor.
data PutAccountSettingDefault = PutAccountSettingDefault'
  { -- | The 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 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.
    --
    -- Fargate is transitioning from task count-based quotas to vCPU-based
    -- quotas. You can set the name to @fargateVCPULimit@ to opt in or opt out
    -- of the vCPU-based quotas. For information about the opt in timeline, see
    -- <https://docs.aws.amazon.com/AmazonECS/latest/developerguide/ecs-account-settings.html#fargate-quota-timeline Fargate vCPU-based quotas timeline>
    -- in the /Amazon ECS Developer Guide/.
    PutAccountSettingDefault -> SettingName
name :: SettingName,
    -- | The account setting value for the specified principal ARN. Accepted
    -- values are @enabled@ and @disabled@.
    PutAccountSettingDefault -> Text
value :: Prelude.Text
  }
  deriving (PutAccountSettingDefault -> PutAccountSettingDefault -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PutAccountSettingDefault -> PutAccountSettingDefault -> Bool
$c/= :: PutAccountSettingDefault -> PutAccountSettingDefault -> Bool
== :: PutAccountSettingDefault -> PutAccountSettingDefault -> Bool
$c== :: PutAccountSettingDefault -> PutAccountSettingDefault -> Bool
Prelude.Eq, ReadPrec [PutAccountSettingDefault]
ReadPrec PutAccountSettingDefault
Int -> ReadS PutAccountSettingDefault
ReadS [PutAccountSettingDefault]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [PutAccountSettingDefault]
$creadListPrec :: ReadPrec [PutAccountSettingDefault]
readPrec :: ReadPrec PutAccountSettingDefault
$creadPrec :: ReadPrec PutAccountSettingDefault
readList :: ReadS [PutAccountSettingDefault]
$creadList :: ReadS [PutAccountSettingDefault]
readsPrec :: Int -> ReadS PutAccountSettingDefault
$creadsPrec :: Int -> ReadS PutAccountSettingDefault
Prelude.Read, Int -> PutAccountSettingDefault -> ShowS
[PutAccountSettingDefault] -> ShowS
PutAccountSettingDefault -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PutAccountSettingDefault] -> ShowS
$cshowList :: [PutAccountSettingDefault] -> ShowS
show :: PutAccountSettingDefault -> String
$cshow :: PutAccountSettingDefault -> String
showsPrec :: Int -> PutAccountSettingDefault -> ShowS
$cshowsPrec :: Int -> PutAccountSettingDefault -> ShowS
Prelude.Show, forall x.
Rep PutAccountSettingDefault x -> PutAccountSettingDefault
forall x.
PutAccountSettingDefault -> Rep PutAccountSettingDefault x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep PutAccountSettingDefault x -> PutAccountSettingDefault
$cfrom :: forall x.
PutAccountSettingDefault -> Rep PutAccountSettingDefault x
Prelude.Generic)

-- |
-- Create a value of 'PutAccountSettingDefault' 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:
--
-- 'name', 'putAccountSettingDefault_name' - The 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 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.
--
-- Fargate is transitioning from task count-based quotas to vCPU-based
-- quotas. You can set the name to @fargateVCPULimit@ to opt in or opt out
-- of the vCPU-based quotas. For information about the opt in timeline, see
-- <https://docs.aws.amazon.com/AmazonECS/latest/developerguide/ecs-account-settings.html#fargate-quota-timeline Fargate vCPU-based quotas timeline>
-- in the /Amazon ECS Developer Guide/.
--
-- 'value', 'putAccountSettingDefault_value' - The account setting value for the specified principal ARN. Accepted
-- values are @enabled@ and @disabled@.
newPutAccountSettingDefault ::
  -- | 'name'
  SettingName ->
  -- | 'value'
  Prelude.Text ->
  PutAccountSettingDefault
newPutAccountSettingDefault :: SettingName -> Text -> PutAccountSettingDefault
newPutAccountSettingDefault SettingName
pName_ Text
pValue_ =
  PutAccountSettingDefault'
    { $sel:name:PutAccountSettingDefault' :: SettingName
name = SettingName
pName_,
      $sel:value:PutAccountSettingDefault' :: Text
value = Text
pValue_
    }

-- | The 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 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.
--
-- Fargate is transitioning from task count-based quotas to vCPU-based
-- quotas. You can set the name to @fargateVCPULimit@ to opt in or opt out
-- of the vCPU-based quotas. For information about the opt in timeline, see
-- <https://docs.aws.amazon.com/AmazonECS/latest/developerguide/ecs-account-settings.html#fargate-quota-timeline Fargate vCPU-based quotas timeline>
-- in the /Amazon ECS Developer Guide/.
putAccountSettingDefault_name :: Lens.Lens' PutAccountSettingDefault SettingName
putAccountSettingDefault_name :: Lens' PutAccountSettingDefault SettingName
putAccountSettingDefault_name = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PutAccountSettingDefault' {SettingName
name :: SettingName
$sel:name:PutAccountSettingDefault' :: PutAccountSettingDefault -> SettingName
name} -> SettingName
name) (\s :: PutAccountSettingDefault
s@PutAccountSettingDefault' {} SettingName
a -> PutAccountSettingDefault
s {$sel:name:PutAccountSettingDefault' :: SettingName
name = SettingName
a} :: PutAccountSettingDefault)

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

instance Core.AWSRequest PutAccountSettingDefault where
  type
    AWSResponse PutAccountSettingDefault =
      PutAccountSettingDefaultResponse
  request :: (Service -> Service)
-> PutAccountSettingDefault -> Request PutAccountSettingDefault
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 PutAccountSettingDefault
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse PutAccountSettingDefault)))
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 -> PutAccountSettingDefaultResponse
PutAccountSettingDefaultResponse'
            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 PutAccountSettingDefault where
  hashWithSalt :: Int -> PutAccountSettingDefault -> Int
hashWithSalt Int
_salt PutAccountSettingDefault' {Text
SettingName
value :: Text
name :: SettingName
$sel:value:PutAccountSettingDefault' :: PutAccountSettingDefault -> Text
$sel:name:PutAccountSettingDefault' :: PutAccountSettingDefault -> SettingName
..} =
    Int
_salt
      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 PutAccountSettingDefault where
  rnf :: PutAccountSettingDefault -> ()
rnf PutAccountSettingDefault' {Text
SettingName
value :: Text
name :: SettingName
$sel:value:PutAccountSettingDefault' :: PutAccountSettingDefault -> Text
$sel:name:PutAccountSettingDefault' :: PutAccountSettingDefault -> SettingName
..} =
    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 PutAccountSettingDefault where
  toHeaders :: PutAccountSettingDefault -> 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.PutAccountSettingDefault" ::
                          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 PutAccountSettingDefault where
  toJSON :: PutAccountSettingDefault -> Value
toJSON PutAccountSettingDefault' {Text
SettingName
value :: Text
name :: SettingName
$sel:value:PutAccountSettingDefault' :: PutAccountSettingDefault -> Text
$sel:name:PutAccountSettingDefault' :: PutAccountSettingDefault -> SettingName
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ 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 PutAccountSettingDefault where
  toPath :: PutAccountSettingDefault -> ByteString
toPath = forall a b. a -> b -> a
Prelude.const ByteString
"/"

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

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

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

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

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

instance
  Prelude.NFData
    PutAccountSettingDefaultResponse
  where
  rnf :: PutAccountSettingDefaultResponse -> ()
rnf PutAccountSettingDefaultResponse' {Int
Maybe Setting
httpStatus :: Int
setting :: Maybe Setting
$sel:httpStatus:PutAccountSettingDefaultResponse' :: PutAccountSettingDefaultResponse -> Int
$sel:setting:PutAccountSettingDefaultResponse' :: PutAccountSettingDefaultResponse -> 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