{-# 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.UpdateContainerInstancesState
-- 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 the status of an Amazon ECS container instance.
--
-- Once a container instance has reached an @ACTIVE@ state, you can change
-- the status of a container instance to @DRAINING@ to manually remove an
-- instance from a cluster, for example to perform system updates, update
-- the Docker daemon, or scale down the cluster size.
--
-- A container instance can\'t be changed to @DRAINING@ until it has
-- reached an @ACTIVE@ status. If the instance is in any other status, an
-- error will be received.
--
-- When you set a container instance to @DRAINING@, Amazon ECS prevents new
-- tasks from being scheduled for placement on the container instance and
-- replacement service tasks are started on other container instances in
-- the cluster if the resources are available. Service tasks on the
-- container instance that are in the @PENDING@ state are stopped
-- immediately.
--
-- Service tasks on the container instance that are in the @RUNNING@ state
-- are stopped and replaced according to the service\'s deployment
-- configuration parameters, @minimumHealthyPercent@ and @maximumPercent@.
-- You can change the deployment configuration of your service using
-- UpdateService.
--
-- -   If @minimumHealthyPercent@ is below 100%, the scheduler can ignore
--     @desiredCount@ temporarily during task replacement. For example,
--     @desiredCount@ is four tasks, a minimum of 50% allows the scheduler
--     to stop two existing tasks before starting two new tasks. If the
--     minimum is 100%, the service scheduler can\'t remove existing tasks
--     until the replacement tasks are considered healthy. Tasks for
--     services that do not use a load balancer are considered healthy if
--     they\'re in the @RUNNING@ state. Tasks for services that use a load
--     balancer are considered healthy if they\'re in the @RUNNING@ state
--     and are reported as healthy by the load balancer.
--
-- -   The @maximumPercent@ parameter represents an upper limit on the
--     number of running tasks during task replacement. You can use this to
--     define the replacement batch size. For example, if @desiredCount@ is
--     four tasks, a maximum of 200% starts four new tasks before stopping
--     the four tasks to be drained, provided that the cluster resources
--     required to do this are available. If the maximum is 100%, then
--     replacement tasks can\'t start until the draining tasks have
--     stopped.
--
-- Any @PENDING@ or @RUNNING@ tasks that do not belong to a service aren\'t
-- affected. You must wait for them to finish or stop them manually.
--
-- A container instance has completed draining when it has no more
-- @RUNNING@ tasks. You can verify this using ListTasks.
--
-- When a container instance has been drained, you can set a container
-- instance to @ACTIVE@ status and once it has reached that status the
-- Amazon ECS scheduler can begin scheduling tasks on the instance again.
module Amazonka.ECS.UpdateContainerInstancesState
  ( -- * Creating a Request
    UpdateContainerInstancesState (..),
    newUpdateContainerInstancesState,

    -- * Request Lenses
    updateContainerInstancesState_cluster,
    updateContainerInstancesState_containerInstances,
    updateContainerInstancesState_status,

    -- * Destructuring the Response
    UpdateContainerInstancesStateResponse (..),
    newUpdateContainerInstancesStateResponse,

    -- * Response Lenses
    updateContainerInstancesStateResponse_containerInstances,
    updateContainerInstancesStateResponse_failures,
    updateContainerInstancesStateResponse_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:/ 'newUpdateContainerInstancesState' smart constructor.
data UpdateContainerInstancesState = UpdateContainerInstancesState'
  { -- | The short name or full Amazon Resource Name (ARN) of the cluster that
    -- hosts the container instance to update. If you do not specify a cluster,
    -- the default cluster is assumed.
    UpdateContainerInstancesState -> Maybe Text
cluster :: Prelude.Maybe Prelude.Text,
    -- | A list of up to 10 container instance IDs or full ARN entries.
    UpdateContainerInstancesState -> [Text]
containerInstances :: [Prelude.Text],
    -- | The container instance state to update the container instance with. The
    -- only valid values for this action are @ACTIVE@ and @DRAINING@. A
    -- container instance can only be updated to @DRAINING@ status once it has
    -- reached an @ACTIVE@ state. If a container instance is in @REGISTERING@,
    -- @DEREGISTERING@, or @REGISTRATION_FAILED@ state you can describe the
    -- container instance but can\'t update the container instance state.
    UpdateContainerInstancesState -> ContainerInstanceStatus
status :: ContainerInstanceStatus
  }
  deriving (UpdateContainerInstancesState
-> UpdateContainerInstancesState -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UpdateContainerInstancesState
-> UpdateContainerInstancesState -> Bool
$c/= :: UpdateContainerInstancesState
-> UpdateContainerInstancesState -> Bool
== :: UpdateContainerInstancesState
-> UpdateContainerInstancesState -> Bool
$c== :: UpdateContainerInstancesState
-> UpdateContainerInstancesState -> Bool
Prelude.Eq, ReadPrec [UpdateContainerInstancesState]
ReadPrec UpdateContainerInstancesState
Int -> ReadS UpdateContainerInstancesState
ReadS [UpdateContainerInstancesState]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [UpdateContainerInstancesState]
$creadListPrec :: ReadPrec [UpdateContainerInstancesState]
readPrec :: ReadPrec UpdateContainerInstancesState
$creadPrec :: ReadPrec UpdateContainerInstancesState
readList :: ReadS [UpdateContainerInstancesState]
$creadList :: ReadS [UpdateContainerInstancesState]
readsPrec :: Int -> ReadS UpdateContainerInstancesState
$creadsPrec :: Int -> ReadS UpdateContainerInstancesState
Prelude.Read, Int -> UpdateContainerInstancesState -> ShowS
[UpdateContainerInstancesState] -> ShowS
UpdateContainerInstancesState -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UpdateContainerInstancesState] -> ShowS
$cshowList :: [UpdateContainerInstancesState] -> ShowS
show :: UpdateContainerInstancesState -> String
$cshow :: UpdateContainerInstancesState -> String
showsPrec :: Int -> UpdateContainerInstancesState -> ShowS
$cshowsPrec :: Int -> UpdateContainerInstancesState -> ShowS
Prelude.Show, forall x.
Rep UpdateContainerInstancesState x
-> UpdateContainerInstancesState
forall x.
UpdateContainerInstancesState
-> Rep UpdateContainerInstancesState x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep UpdateContainerInstancesState x
-> UpdateContainerInstancesState
$cfrom :: forall x.
UpdateContainerInstancesState
-> Rep UpdateContainerInstancesState x
Prelude.Generic)

-- |
-- Create a value of 'UpdateContainerInstancesState' 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:
--
-- 'cluster', 'updateContainerInstancesState_cluster' - The short name or full Amazon Resource Name (ARN) of the cluster that
-- hosts the container instance to update. If you do not specify a cluster,
-- the default cluster is assumed.
--
-- 'containerInstances', 'updateContainerInstancesState_containerInstances' - A list of up to 10 container instance IDs or full ARN entries.
--
-- 'status', 'updateContainerInstancesState_status' - The container instance state to update the container instance with. The
-- only valid values for this action are @ACTIVE@ and @DRAINING@. A
-- container instance can only be updated to @DRAINING@ status once it has
-- reached an @ACTIVE@ state. If a container instance is in @REGISTERING@,
-- @DEREGISTERING@, or @REGISTRATION_FAILED@ state you can describe the
-- container instance but can\'t update the container instance state.
newUpdateContainerInstancesState ::
  -- | 'status'
  ContainerInstanceStatus ->
  UpdateContainerInstancesState
newUpdateContainerInstancesState :: ContainerInstanceStatus -> UpdateContainerInstancesState
newUpdateContainerInstancesState ContainerInstanceStatus
pStatus_ =
  UpdateContainerInstancesState'
    { $sel:cluster:UpdateContainerInstancesState' :: Maybe Text
cluster =
        forall a. Maybe a
Prelude.Nothing,
      $sel:containerInstances:UpdateContainerInstancesState' :: [Text]
containerInstances = forall a. Monoid a => a
Prelude.mempty,
      $sel:status:UpdateContainerInstancesState' :: ContainerInstanceStatus
status = ContainerInstanceStatus
pStatus_
    }

-- | The short name or full Amazon Resource Name (ARN) of the cluster that
-- hosts the container instance to update. If you do not specify a cluster,
-- the default cluster is assumed.
updateContainerInstancesState_cluster :: Lens.Lens' UpdateContainerInstancesState (Prelude.Maybe Prelude.Text)
updateContainerInstancesState_cluster :: Lens' UpdateContainerInstancesState (Maybe Text)
updateContainerInstancesState_cluster = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateContainerInstancesState' {Maybe Text
cluster :: Maybe Text
$sel:cluster:UpdateContainerInstancesState' :: UpdateContainerInstancesState -> Maybe Text
cluster} -> Maybe Text
cluster) (\s :: UpdateContainerInstancesState
s@UpdateContainerInstancesState' {} Maybe Text
a -> UpdateContainerInstancesState
s {$sel:cluster:UpdateContainerInstancesState' :: Maybe Text
cluster = Maybe Text
a} :: UpdateContainerInstancesState)

-- | A list of up to 10 container instance IDs or full ARN entries.
updateContainerInstancesState_containerInstances :: Lens.Lens' UpdateContainerInstancesState [Prelude.Text]
updateContainerInstancesState_containerInstances :: Lens' UpdateContainerInstancesState [Text]
updateContainerInstancesState_containerInstances = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateContainerInstancesState' {[Text]
containerInstances :: [Text]
$sel:containerInstances:UpdateContainerInstancesState' :: UpdateContainerInstancesState -> [Text]
containerInstances} -> [Text]
containerInstances) (\s :: UpdateContainerInstancesState
s@UpdateContainerInstancesState' {} [Text]
a -> UpdateContainerInstancesState
s {$sel:containerInstances:UpdateContainerInstancesState' :: [Text]
containerInstances = [Text]
a} :: UpdateContainerInstancesState) 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

-- | The container instance state to update the container instance with. The
-- only valid values for this action are @ACTIVE@ and @DRAINING@. A
-- container instance can only be updated to @DRAINING@ status once it has
-- reached an @ACTIVE@ state. If a container instance is in @REGISTERING@,
-- @DEREGISTERING@, or @REGISTRATION_FAILED@ state you can describe the
-- container instance but can\'t update the container instance state.
updateContainerInstancesState_status :: Lens.Lens' UpdateContainerInstancesState ContainerInstanceStatus
updateContainerInstancesState_status :: Lens' UpdateContainerInstancesState ContainerInstanceStatus
updateContainerInstancesState_status = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateContainerInstancesState' {ContainerInstanceStatus
status :: ContainerInstanceStatus
$sel:status:UpdateContainerInstancesState' :: UpdateContainerInstancesState -> ContainerInstanceStatus
status} -> ContainerInstanceStatus
status) (\s :: UpdateContainerInstancesState
s@UpdateContainerInstancesState' {} ContainerInstanceStatus
a -> UpdateContainerInstancesState
s {$sel:status:UpdateContainerInstancesState' :: ContainerInstanceStatus
status = ContainerInstanceStatus
a} :: UpdateContainerInstancesState)

instance
  Core.AWSRequest
    UpdateContainerInstancesState
  where
  type
    AWSResponse UpdateContainerInstancesState =
      UpdateContainerInstancesStateResponse
  request :: (Service -> Service)
-> UpdateContainerInstancesState
-> Request UpdateContainerInstancesState
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 UpdateContainerInstancesState
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse UpdateContainerInstancesState)))
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 [ContainerInstance]
-> Maybe [Failure] -> Int -> UpdateContainerInstancesStateResponse
UpdateContainerInstancesStateResponse'
            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
"containerInstances"
                            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
"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.<*> (forall (f :: * -> *) a. Applicative f => a -> f a
Prelude.pure (forall a. Enum a => a -> Int
Prelude.fromEnum Int
s))
      )

instance
  Prelude.Hashable
    UpdateContainerInstancesState
  where
  hashWithSalt :: Int -> UpdateContainerInstancesState -> Int
hashWithSalt Int
_salt UpdateContainerInstancesState' {[Text]
Maybe Text
ContainerInstanceStatus
status :: ContainerInstanceStatus
containerInstances :: [Text]
cluster :: Maybe Text
$sel:status:UpdateContainerInstancesState' :: UpdateContainerInstancesState -> ContainerInstanceStatus
$sel:containerInstances:UpdateContainerInstancesState' :: UpdateContainerInstancesState -> [Text]
$sel:cluster:UpdateContainerInstancesState' :: UpdateContainerInstancesState -> Maybe Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
cluster
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` [Text]
containerInstances
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` ContainerInstanceStatus
status

instance Prelude.NFData UpdateContainerInstancesState where
  rnf :: UpdateContainerInstancesState -> ()
rnf UpdateContainerInstancesState' {[Text]
Maybe Text
ContainerInstanceStatus
status :: ContainerInstanceStatus
containerInstances :: [Text]
cluster :: Maybe Text
$sel:status:UpdateContainerInstancesState' :: UpdateContainerInstancesState -> ContainerInstanceStatus
$sel:containerInstances:UpdateContainerInstancesState' :: UpdateContainerInstancesState -> [Text]
$sel:cluster:UpdateContainerInstancesState' :: UpdateContainerInstancesState -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
cluster
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf [Text]
containerInstances
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf ContainerInstanceStatus
status

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

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

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

-- | /See:/ 'newUpdateContainerInstancesStateResponse' smart constructor.
data UpdateContainerInstancesStateResponse = UpdateContainerInstancesStateResponse'
  { -- | The list of container instances.
    UpdateContainerInstancesStateResponse -> Maybe [ContainerInstance]
containerInstances :: Prelude.Maybe [ContainerInstance],
    -- | Any failures associated with the call.
    UpdateContainerInstancesStateResponse -> Maybe [Failure]
failures :: Prelude.Maybe [Failure],
    -- | The response's http status code.
    UpdateContainerInstancesStateResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (UpdateContainerInstancesStateResponse
-> UpdateContainerInstancesStateResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UpdateContainerInstancesStateResponse
-> UpdateContainerInstancesStateResponse -> Bool
$c/= :: UpdateContainerInstancesStateResponse
-> UpdateContainerInstancesStateResponse -> Bool
== :: UpdateContainerInstancesStateResponse
-> UpdateContainerInstancesStateResponse -> Bool
$c== :: UpdateContainerInstancesStateResponse
-> UpdateContainerInstancesStateResponse -> Bool
Prelude.Eq, ReadPrec [UpdateContainerInstancesStateResponse]
ReadPrec UpdateContainerInstancesStateResponse
Int -> ReadS UpdateContainerInstancesStateResponse
ReadS [UpdateContainerInstancesStateResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [UpdateContainerInstancesStateResponse]
$creadListPrec :: ReadPrec [UpdateContainerInstancesStateResponse]
readPrec :: ReadPrec UpdateContainerInstancesStateResponse
$creadPrec :: ReadPrec UpdateContainerInstancesStateResponse
readList :: ReadS [UpdateContainerInstancesStateResponse]
$creadList :: ReadS [UpdateContainerInstancesStateResponse]
readsPrec :: Int -> ReadS UpdateContainerInstancesStateResponse
$creadsPrec :: Int -> ReadS UpdateContainerInstancesStateResponse
Prelude.Read, Int -> UpdateContainerInstancesStateResponse -> ShowS
[UpdateContainerInstancesStateResponse] -> ShowS
UpdateContainerInstancesStateResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UpdateContainerInstancesStateResponse] -> ShowS
$cshowList :: [UpdateContainerInstancesStateResponse] -> ShowS
show :: UpdateContainerInstancesStateResponse -> String
$cshow :: UpdateContainerInstancesStateResponse -> String
showsPrec :: Int -> UpdateContainerInstancesStateResponse -> ShowS
$cshowsPrec :: Int -> UpdateContainerInstancesStateResponse -> ShowS
Prelude.Show, forall x.
Rep UpdateContainerInstancesStateResponse x
-> UpdateContainerInstancesStateResponse
forall x.
UpdateContainerInstancesStateResponse
-> Rep UpdateContainerInstancesStateResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep UpdateContainerInstancesStateResponse x
-> UpdateContainerInstancesStateResponse
$cfrom :: forall x.
UpdateContainerInstancesStateResponse
-> Rep UpdateContainerInstancesStateResponse x
Prelude.Generic)

-- |
-- Create a value of 'UpdateContainerInstancesStateResponse' 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:
--
-- 'containerInstances', 'updateContainerInstancesStateResponse_containerInstances' - The list of container instances.
--
-- 'failures', 'updateContainerInstancesStateResponse_failures' - Any failures associated with the call.
--
-- 'httpStatus', 'updateContainerInstancesStateResponse_httpStatus' - The response's http status code.
newUpdateContainerInstancesStateResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  UpdateContainerInstancesStateResponse
newUpdateContainerInstancesStateResponse :: Int -> UpdateContainerInstancesStateResponse
newUpdateContainerInstancesStateResponse Int
pHttpStatus_ =
  UpdateContainerInstancesStateResponse'
    { $sel:containerInstances:UpdateContainerInstancesStateResponse' :: Maybe [ContainerInstance]
containerInstances =
        forall a. Maybe a
Prelude.Nothing,
      $sel:failures:UpdateContainerInstancesStateResponse' :: Maybe [Failure]
failures = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:UpdateContainerInstancesStateResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | The list of container instances.
updateContainerInstancesStateResponse_containerInstances :: Lens.Lens' UpdateContainerInstancesStateResponse (Prelude.Maybe [ContainerInstance])
updateContainerInstancesStateResponse_containerInstances :: Lens'
  UpdateContainerInstancesStateResponse (Maybe [ContainerInstance])
updateContainerInstancesStateResponse_containerInstances = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateContainerInstancesStateResponse' {Maybe [ContainerInstance]
containerInstances :: Maybe [ContainerInstance]
$sel:containerInstances:UpdateContainerInstancesStateResponse' :: UpdateContainerInstancesStateResponse -> Maybe [ContainerInstance]
containerInstances} -> Maybe [ContainerInstance]
containerInstances) (\s :: UpdateContainerInstancesStateResponse
s@UpdateContainerInstancesStateResponse' {} Maybe [ContainerInstance]
a -> UpdateContainerInstancesStateResponse
s {$sel:containerInstances:UpdateContainerInstancesStateResponse' :: Maybe [ContainerInstance]
containerInstances = Maybe [ContainerInstance]
a} :: UpdateContainerInstancesStateResponse) 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

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

instance
  Prelude.NFData
    UpdateContainerInstancesStateResponse
  where
  rnf :: UpdateContainerInstancesStateResponse -> ()
rnf UpdateContainerInstancesStateResponse' {Int
Maybe [Failure]
Maybe [ContainerInstance]
httpStatus :: Int
failures :: Maybe [Failure]
containerInstances :: Maybe [ContainerInstance]
$sel:httpStatus:UpdateContainerInstancesStateResponse' :: UpdateContainerInstancesStateResponse -> Int
$sel:failures:UpdateContainerInstancesStateResponse' :: UpdateContainerInstancesStateResponse -> Maybe [Failure]
$sel:containerInstances:UpdateContainerInstancesStateResponse' :: UpdateContainerInstancesStateResponse -> Maybe [ContainerInstance]
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe [ContainerInstance]
containerInstances
      seq :: forall a b. a -> b -> b
`Prelude.seq` 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 Int
httpStatus