{-# 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.UpdateTaskProtection
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Updates the protection status of a task. You can set @protectionEnabled@
-- to @true@ to protect your task from termination during scale-in events
-- from
-- <https://docs.aws.amazon.com/AmazonECS/latest/developerguide/service-auto-scaling.html Service Autoscaling>
-- or
-- <https://docs.aws.amazon.com/AmazonECS/latest/developerguide/deployment-types.html deployments>.
--
-- Task-protection, by default, expires after 2 hours at which point Amazon
-- ECS unsets the @protectionEnabled@ property making the task eligible for
-- termination by a subsequent scale-in event.
--
-- You can specify a custom expiration period for task protection from 1
-- minute to up to 2,880 minutes (48 hours). To specify the custom
-- expiration period, set the @expiresInMinutes@ property. The
-- @expiresInMinutes@ property is always reset when you invoke this
-- operation for a task that already has @protectionEnabled@ set to @true@.
-- You can keep extending the protection expiration period of a task by
-- invoking this operation repeatedly.
--
-- To learn more about Amazon ECS task protection, see
-- <https://docs.aws.amazon.com/AmazonECS/latest/developerguide/task-scale-in-protection.html Task scale-in protection>
-- in the //Amazon Elastic Container Service Developer Guide// .
--
-- This operation is only supported for tasks belonging to an Amazon ECS
-- service. Invoking this operation for a standalone task will result in an
-- @TASK_NOT_VALID@ failure. For more information, see
-- <https://docs.aws.amazon.com/AmazonECS/latest/developerguide/api_failures_messages.html API failure reasons>.
--
-- If you prefer to set task protection from within the container, we
-- recommend using the
-- <https://docs.aws.amazon.com/AmazonECS/latest/developerguide/task-scale-in-protection-endpoint.html Task scale-in protection endpoint>.
module Amazonka.ECS.UpdateTaskProtection
  ( -- * Creating a Request
    UpdateTaskProtection (..),
    newUpdateTaskProtection,

    -- * Request Lenses
    updateTaskProtection_expiresInMinutes,
    updateTaskProtection_cluster,
    updateTaskProtection_tasks,
    updateTaskProtection_protectionEnabled,

    -- * Destructuring the Response
    UpdateTaskProtectionResponse (..),
    newUpdateTaskProtectionResponse,

    -- * Response Lenses
    updateTaskProtectionResponse_failures,
    updateTaskProtectionResponse_protectedTasks,
    updateTaskProtectionResponse_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:/ 'newUpdateTaskProtection' smart constructor.
data UpdateTaskProtection = UpdateTaskProtection'
  { -- | If you set @protectionEnabled@ to @true@, you can specify the duration
    -- for task protection in minutes. You can specify a value from 1 minute to
    -- up to 2,880 minutes (48 hours). During this time, your task will not be
    -- terminated by scale-in events from Service Auto Scaling or deployments.
    -- After this time period lapses, @protectionEnabled@ will be reset to
    -- @false@.
    --
    -- If you don’t specify the time, then the task is automatically protected
    -- for 120 minutes (2 hours).
    UpdateTaskProtection -> Maybe Int
expiresInMinutes :: Prelude.Maybe Prelude.Int,
    -- | The short name or full Amazon Resource Name (ARN) of the cluster that
    -- hosts the service that the task sets exist in.
    UpdateTaskProtection -> Text
cluster :: Prelude.Text,
    -- | A list of up to 10 task IDs or full ARN entries.
    UpdateTaskProtection -> [Text]
tasks :: [Prelude.Text],
    -- | Specify @true@ to mark a task for protection and @false@ to unset
    -- protection, making it eligible for termination.
    UpdateTaskProtection -> Bool
protectionEnabled :: Prelude.Bool
  }
  deriving (UpdateTaskProtection -> UpdateTaskProtection -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UpdateTaskProtection -> UpdateTaskProtection -> Bool
$c/= :: UpdateTaskProtection -> UpdateTaskProtection -> Bool
== :: UpdateTaskProtection -> UpdateTaskProtection -> Bool
$c== :: UpdateTaskProtection -> UpdateTaskProtection -> Bool
Prelude.Eq, ReadPrec [UpdateTaskProtection]
ReadPrec UpdateTaskProtection
Int -> ReadS UpdateTaskProtection
ReadS [UpdateTaskProtection]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [UpdateTaskProtection]
$creadListPrec :: ReadPrec [UpdateTaskProtection]
readPrec :: ReadPrec UpdateTaskProtection
$creadPrec :: ReadPrec UpdateTaskProtection
readList :: ReadS [UpdateTaskProtection]
$creadList :: ReadS [UpdateTaskProtection]
readsPrec :: Int -> ReadS UpdateTaskProtection
$creadsPrec :: Int -> ReadS UpdateTaskProtection
Prelude.Read, Int -> UpdateTaskProtection -> ShowS
[UpdateTaskProtection] -> ShowS
UpdateTaskProtection -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UpdateTaskProtection] -> ShowS
$cshowList :: [UpdateTaskProtection] -> ShowS
show :: UpdateTaskProtection -> String
$cshow :: UpdateTaskProtection -> String
showsPrec :: Int -> UpdateTaskProtection -> ShowS
$cshowsPrec :: Int -> UpdateTaskProtection -> ShowS
Prelude.Show, forall x. Rep UpdateTaskProtection x -> UpdateTaskProtection
forall x. UpdateTaskProtection -> Rep UpdateTaskProtection x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep UpdateTaskProtection x -> UpdateTaskProtection
$cfrom :: forall x. UpdateTaskProtection -> Rep UpdateTaskProtection x
Prelude.Generic)

-- |
-- Create a value of 'UpdateTaskProtection' 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:
--
-- 'expiresInMinutes', 'updateTaskProtection_expiresInMinutes' - If you set @protectionEnabled@ to @true@, you can specify the duration
-- for task protection in minutes. You can specify a value from 1 minute to
-- up to 2,880 minutes (48 hours). During this time, your task will not be
-- terminated by scale-in events from Service Auto Scaling or deployments.
-- After this time period lapses, @protectionEnabled@ will be reset to
-- @false@.
--
-- If you don’t specify the time, then the task is automatically protected
-- for 120 minutes (2 hours).
--
-- 'cluster', 'updateTaskProtection_cluster' - The short name or full Amazon Resource Name (ARN) of the cluster that
-- hosts the service that the task sets exist in.
--
-- 'tasks', 'updateTaskProtection_tasks' - A list of up to 10 task IDs or full ARN entries.
--
-- 'protectionEnabled', 'updateTaskProtection_protectionEnabled' - Specify @true@ to mark a task for protection and @false@ to unset
-- protection, making it eligible for termination.
newUpdateTaskProtection ::
  -- | 'cluster'
  Prelude.Text ->
  -- | 'protectionEnabled'
  Prelude.Bool ->
  UpdateTaskProtection
newUpdateTaskProtection :: Text -> Bool -> UpdateTaskProtection
newUpdateTaskProtection Text
pCluster_ Bool
pProtectionEnabled_ =
  UpdateTaskProtection'
    { $sel:expiresInMinutes:UpdateTaskProtection' :: Maybe Int
expiresInMinutes =
        forall a. Maybe a
Prelude.Nothing,
      $sel:cluster:UpdateTaskProtection' :: Text
cluster = Text
pCluster_,
      $sel:tasks:UpdateTaskProtection' :: [Text]
tasks = forall a. Monoid a => a
Prelude.mempty,
      $sel:protectionEnabled:UpdateTaskProtection' :: Bool
protectionEnabled = Bool
pProtectionEnabled_
    }

-- | If you set @protectionEnabled@ to @true@, you can specify the duration
-- for task protection in minutes. You can specify a value from 1 minute to
-- up to 2,880 minutes (48 hours). During this time, your task will not be
-- terminated by scale-in events from Service Auto Scaling or deployments.
-- After this time period lapses, @protectionEnabled@ will be reset to
-- @false@.
--
-- If you don’t specify the time, then the task is automatically protected
-- for 120 minutes (2 hours).
updateTaskProtection_expiresInMinutes :: Lens.Lens' UpdateTaskProtection (Prelude.Maybe Prelude.Int)
updateTaskProtection_expiresInMinutes :: Lens' UpdateTaskProtection (Maybe Int)
updateTaskProtection_expiresInMinutes = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateTaskProtection' {Maybe Int
expiresInMinutes :: Maybe Int
$sel:expiresInMinutes:UpdateTaskProtection' :: UpdateTaskProtection -> Maybe Int
expiresInMinutes} -> Maybe Int
expiresInMinutes) (\s :: UpdateTaskProtection
s@UpdateTaskProtection' {} Maybe Int
a -> UpdateTaskProtection
s {$sel:expiresInMinutes:UpdateTaskProtection' :: Maybe Int
expiresInMinutes = Maybe Int
a} :: UpdateTaskProtection)

-- | The short name or full Amazon Resource Name (ARN) of the cluster that
-- hosts the service that the task sets exist in.
updateTaskProtection_cluster :: Lens.Lens' UpdateTaskProtection Prelude.Text
updateTaskProtection_cluster :: Lens' UpdateTaskProtection Text
updateTaskProtection_cluster = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateTaskProtection' {Text
cluster :: Text
$sel:cluster:UpdateTaskProtection' :: UpdateTaskProtection -> Text
cluster} -> Text
cluster) (\s :: UpdateTaskProtection
s@UpdateTaskProtection' {} Text
a -> UpdateTaskProtection
s {$sel:cluster:UpdateTaskProtection' :: Text
cluster = Text
a} :: UpdateTaskProtection)

-- | A list of up to 10 task IDs or full ARN entries.
updateTaskProtection_tasks :: Lens.Lens' UpdateTaskProtection [Prelude.Text]
updateTaskProtection_tasks :: Lens' UpdateTaskProtection [Text]
updateTaskProtection_tasks = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateTaskProtection' {[Text]
tasks :: [Text]
$sel:tasks:UpdateTaskProtection' :: UpdateTaskProtection -> [Text]
tasks} -> [Text]
tasks) (\s :: UpdateTaskProtection
s@UpdateTaskProtection' {} [Text]
a -> UpdateTaskProtection
s {$sel:tasks:UpdateTaskProtection' :: [Text]
tasks = [Text]
a} :: UpdateTaskProtection) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Lens.coerced

-- | Specify @true@ to mark a task for protection and @false@ to unset
-- protection, making it eligible for termination.
updateTaskProtection_protectionEnabled :: Lens.Lens' UpdateTaskProtection Prelude.Bool
updateTaskProtection_protectionEnabled :: Lens' UpdateTaskProtection Bool
updateTaskProtection_protectionEnabled = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateTaskProtection' {Bool
protectionEnabled :: Bool
$sel:protectionEnabled:UpdateTaskProtection' :: UpdateTaskProtection -> Bool
protectionEnabled} -> Bool
protectionEnabled) (\s :: UpdateTaskProtection
s@UpdateTaskProtection' {} Bool
a -> UpdateTaskProtection
s {$sel:protectionEnabled:UpdateTaskProtection' :: Bool
protectionEnabled = Bool
a} :: UpdateTaskProtection)

instance Core.AWSRequest UpdateTaskProtection where
  type
    AWSResponse UpdateTaskProtection =
      UpdateTaskProtectionResponse
  request :: (Service -> Service)
-> UpdateTaskProtection -> Request UpdateTaskProtection
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 UpdateTaskProtection
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse UpdateTaskProtection)))
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 [Failure]
-> Maybe [ProtectedTask] -> Int -> UpdateTaskProtectionResponse
UpdateTaskProtectionResponse'
            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
"failures" forall (f :: * -> *) a. Functor f => f (Maybe a) -> a -> f a
Core..!@ forall a. Monoid a => a
Prelude.mempty)
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"protectedTasks" forall (f :: * -> *) a. Functor f => f (Maybe a) -> a -> f a
Core..!@ forall a. Monoid a => a
Prelude.mempty)
            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 UpdateTaskProtection where
  hashWithSalt :: Int -> UpdateTaskProtection -> Int
hashWithSalt Int
_salt UpdateTaskProtection' {Bool
[Text]
Maybe Int
Text
protectionEnabled :: Bool
tasks :: [Text]
cluster :: Text
expiresInMinutes :: Maybe Int
$sel:protectionEnabled:UpdateTaskProtection' :: UpdateTaskProtection -> Bool
$sel:tasks:UpdateTaskProtection' :: UpdateTaskProtection -> [Text]
$sel:cluster:UpdateTaskProtection' :: UpdateTaskProtection -> Text
$sel:expiresInMinutes:UpdateTaskProtection' :: UpdateTaskProtection -> Maybe Int
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Int
expiresInMinutes
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
cluster
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` [Text]
tasks
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Bool
protectionEnabled

instance Prelude.NFData UpdateTaskProtection where
  rnf :: UpdateTaskProtection -> ()
rnf UpdateTaskProtection' {Bool
[Text]
Maybe Int
Text
protectionEnabled :: Bool
tasks :: [Text]
cluster :: Text
expiresInMinutes :: Maybe Int
$sel:protectionEnabled:UpdateTaskProtection' :: UpdateTaskProtection -> Bool
$sel:tasks:UpdateTaskProtection' :: UpdateTaskProtection -> [Text]
$sel:cluster:UpdateTaskProtection' :: UpdateTaskProtection -> Text
$sel:expiresInMinutes:UpdateTaskProtection' :: UpdateTaskProtection -> Maybe Int
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Int
expiresInMinutes
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
cluster
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf [Text]
tasks
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Bool
protectionEnabled

instance Data.ToHeaders UpdateTaskProtection where
  toHeaders :: UpdateTaskProtection -> 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.UpdateTaskProtection" ::
                          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 UpdateTaskProtection where
  toJSON :: UpdateTaskProtection -> Value
toJSON UpdateTaskProtection' {Bool
[Text]
Maybe Int
Text
protectionEnabled :: Bool
tasks :: [Text]
cluster :: Text
expiresInMinutes :: Maybe Int
$sel:protectionEnabled:UpdateTaskProtection' :: UpdateTaskProtection -> Bool
$sel:tasks:UpdateTaskProtection' :: UpdateTaskProtection -> [Text]
$sel:cluster:UpdateTaskProtection' :: UpdateTaskProtection -> Text
$sel:expiresInMinutes:UpdateTaskProtection' :: UpdateTaskProtection -> Maybe Int
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"expiresInMinutes" 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 Int
expiresInMinutes,
            forall a. a -> Maybe a
Prelude.Just (Key
"cluster" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
cluster),
            forall a. a -> Maybe a
Prelude.Just (Key
"tasks" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= [Text]
tasks),
            forall a. a -> Maybe a
Prelude.Just
              (Key
"protectionEnabled" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Bool
protectionEnabled)
          ]
      )

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

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

-- | /See:/ 'newUpdateTaskProtectionResponse' smart constructor.
data UpdateTaskProtectionResponse = UpdateTaskProtectionResponse'
  { -- | Any failures associated with the call.
    UpdateTaskProtectionResponse -> Maybe [Failure]
failures :: Prelude.Maybe [Failure],
    -- | A list of tasks with the following information.
    --
    -- -   @taskArn@: The task ARN.
    --
    -- -   @protectionEnabled@: The protection status of the task. If scale-in
    --     protection is enabled for a task, the value is @true@. Otherwise, it
    --     is @false@.
    --
    -- -   @expirationDate@: The epoch time when protection for the task will
    --     expire.
    UpdateTaskProtectionResponse -> Maybe [ProtectedTask]
protectedTasks :: Prelude.Maybe [ProtectedTask],
    -- | The response's http status code.
    UpdateTaskProtectionResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (UpdateTaskProtectionResponse
-> UpdateTaskProtectionResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UpdateTaskProtectionResponse
-> UpdateTaskProtectionResponse -> Bool
$c/= :: UpdateTaskProtectionResponse
-> UpdateTaskProtectionResponse -> Bool
== :: UpdateTaskProtectionResponse
-> UpdateTaskProtectionResponse -> Bool
$c== :: UpdateTaskProtectionResponse
-> UpdateTaskProtectionResponse -> Bool
Prelude.Eq, ReadPrec [UpdateTaskProtectionResponse]
ReadPrec UpdateTaskProtectionResponse
Int -> ReadS UpdateTaskProtectionResponse
ReadS [UpdateTaskProtectionResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [UpdateTaskProtectionResponse]
$creadListPrec :: ReadPrec [UpdateTaskProtectionResponse]
readPrec :: ReadPrec UpdateTaskProtectionResponse
$creadPrec :: ReadPrec UpdateTaskProtectionResponse
readList :: ReadS [UpdateTaskProtectionResponse]
$creadList :: ReadS [UpdateTaskProtectionResponse]
readsPrec :: Int -> ReadS UpdateTaskProtectionResponse
$creadsPrec :: Int -> ReadS UpdateTaskProtectionResponse
Prelude.Read, Int -> UpdateTaskProtectionResponse -> ShowS
[UpdateTaskProtectionResponse] -> ShowS
UpdateTaskProtectionResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UpdateTaskProtectionResponse] -> ShowS
$cshowList :: [UpdateTaskProtectionResponse] -> ShowS
show :: UpdateTaskProtectionResponse -> String
$cshow :: UpdateTaskProtectionResponse -> String
showsPrec :: Int -> UpdateTaskProtectionResponse -> ShowS
$cshowsPrec :: Int -> UpdateTaskProtectionResponse -> ShowS
Prelude.Show, forall x.
Rep UpdateTaskProtectionResponse x -> UpdateTaskProtectionResponse
forall x.
UpdateTaskProtectionResponse -> Rep UpdateTaskProtectionResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep UpdateTaskProtectionResponse x -> UpdateTaskProtectionResponse
$cfrom :: forall x.
UpdateTaskProtectionResponse -> Rep UpdateTaskProtectionResponse x
Prelude.Generic)

-- |
-- Create a value of 'UpdateTaskProtectionResponse' 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:
--
-- 'failures', 'updateTaskProtectionResponse_failures' - Any failures associated with the call.
--
-- 'protectedTasks', 'updateTaskProtectionResponse_protectedTasks' - A list of tasks with the following information.
--
-- -   @taskArn@: The task ARN.
--
-- -   @protectionEnabled@: The protection status of the task. If scale-in
--     protection is enabled for a task, the value is @true@. Otherwise, it
--     is @false@.
--
-- -   @expirationDate@: The epoch time when protection for the task will
--     expire.
--
-- 'httpStatus', 'updateTaskProtectionResponse_httpStatus' - The response's http status code.
newUpdateTaskProtectionResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  UpdateTaskProtectionResponse
newUpdateTaskProtectionResponse :: Int -> UpdateTaskProtectionResponse
newUpdateTaskProtectionResponse Int
pHttpStatus_ =
  UpdateTaskProtectionResponse'
    { $sel:failures:UpdateTaskProtectionResponse' :: Maybe [Failure]
failures =
        forall a. Maybe a
Prelude.Nothing,
      $sel:protectedTasks:UpdateTaskProtectionResponse' :: Maybe [ProtectedTask]
protectedTasks = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:UpdateTaskProtectionResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | Any failures associated with the call.
updateTaskProtectionResponse_failures :: Lens.Lens' UpdateTaskProtectionResponse (Prelude.Maybe [Failure])
updateTaskProtectionResponse_failures :: Lens' UpdateTaskProtectionResponse (Maybe [Failure])
updateTaskProtectionResponse_failures = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateTaskProtectionResponse' {Maybe [Failure]
failures :: Maybe [Failure]
$sel:failures:UpdateTaskProtectionResponse' :: UpdateTaskProtectionResponse -> Maybe [Failure]
failures} -> Maybe [Failure]
failures) (\s :: UpdateTaskProtectionResponse
s@UpdateTaskProtectionResponse' {} Maybe [Failure]
a -> UpdateTaskProtectionResponse
s {$sel:failures:UpdateTaskProtectionResponse' :: Maybe [Failure]
failures = Maybe [Failure]
a} :: UpdateTaskProtectionResponse) 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

-- | A list of tasks with the following information.
--
-- -   @taskArn@: The task ARN.
--
-- -   @protectionEnabled@: The protection status of the task. If scale-in
--     protection is enabled for a task, the value is @true@. Otherwise, it
--     is @false@.
--
-- -   @expirationDate@: The epoch time when protection for the task will
--     expire.
updateTaskProtectionResponse_protectedTasks :: Lens.Lens' UpdateTaskProtectionResponse (Prelude.Maybe [ProtectedTask])
updateTaskProtectionResponse_protectedTasks :: Lens' UpdateTaskProtectionResponse (Maybe [ProtectedTask])
updateTaskProtectionResponse_protectedTasks = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateTaskProtectionResponse' {Maybe [ProtectedTask]
protectedTasks :: Maybe [ProtectedTask]
$sel:protectedTasks:UpdateTaskProtectionResponse' :: UpdateTaskProtectionResponse -> Maybe [ProtectedTask]
protectedTasks} -> Maybe [ProtectedTask]
protectedTasks) (\s :: UpdateTaskProtectionResponse
s@UpdateTaskProtectionResponse' {} Maybe [ProtectedTask]
a -> UpdateTaskProtectionResponse
s {$sel:protectedTasks:UpdateTaskProtectionResponse' :: Maybe [ProtectedTask]
protectedTasks = Maybe [ProtectedTask]
a} :: UpdateTaskProtectionResponse) 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 response's http status code.
updateTaskProtectionResponse_httpStatus :: Lens.Lens' UpdateTaskProtectionResponse Prelude.Int
updateTaskProtectionResponse_httpStatus :: Lens' UpdateTaskProtectionResponse Int
updateTaskProtectionResponse_httpStatus = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateTaskProtectionResponse' {Int
httpStatus :: Int
$sel:httpStatus:UpdateTaskProtectionResponse' :: UpdateTaskProtectionResponse -> Int
httpStatus} -> Int
httpStatus) (\s :: UpdateTaskProtectionResponse
s@UpdateTaskProtectionResponse' {} Int
a -> UpdateTaskProtectionResponse
s {$sel:httpStatus:UpdateTaskProtectionResponse' :: Int
httpStatus = Int
a} :: UpdateTaskProtectionResponse)

instance Prelude.NFData UpdateTaskProtectionResponse where
  rnf :: UpdateTaskProtectionResponse -> ()
rnf UpdateTaskProtectionResponse' {Int
Maybe [Failure]
Maybe [ProtectedTask]
httpStatus :: Int
protectedTasks :: Maybe [ProtectedTask]
failures :: Maybe [Failure]
$sel:httpStatus:UpdateTaskProtectionResponse' :: UpdateTaskProtectionResponse -> Int
$sel:protectedTasks:UpdateTaskProtectionResponse' :: UpdateTaskProtectionResponse -> Maybe [ProtectedTask]
$sel:failures:UpdateTaskProtectionResponse' :: UpdateTaskProtectionResponse -> Maybe [Failure]
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe [Failure]
failures
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [ProtectedTask]
protectedTasks
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus