{-# 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.UpdateContainerAgent
-- 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 Amazon ECS container agent on a specified container
-- instance. Updating the Amazon ECS container agent doesn\'t interrupt
-- running tasks or services on the container instance. The process for
-- updating the agent differs depending on whether your container instance
-- was launched with the Amazon ECS-optimized AMI or another operating
-- system.
--
-- The @UpdateContainerAgent@ API isn\'t supported for container instances
-- using the Amazon ECS-optimized Amazon Linux 2 (arm64) AMI. To update the
-- container agent, you can update the @ecs-init@ package. This updates the
-- agent. For more information, see
-- <https://docs.aws.amazon.com/AmazonECS/latest/developerguide/agent-update-ecs-ami.html Updating the Amazon ECS container agent>
-- in the /Amazon Elastic Container Service Developer Guide/.
--
-- Agent updates with the @UpdateContainerAgent@ API operation do not apply
-- to Windows container instances. We recommend that you launch new
-- container instances to update the agent version in your Windows
-- clusters.
--
-- The @UpdateContainerAgent@ API requires an Amazon ECS-optimized AMI or
-- Amazon Linux AMI with the @ecs-init@ service installed and running. For
-- help updating the Amazon ECS container agent on other operating systems,
-- see
-- <https://docs.aws.amazon.com/AmazonECS/latest/developerguide/ecs-agent-update.html#manually_update_agent Manually updating the Amazon ECS container agent>
-- in the /Amazon Elastic Container Service Developer Guide/.
module Amazonka.ECS.UpdateContainerAgent
  ( -- * Creating a Request
    UpdateContainerAgent (..),
    newUpdateContainerAgent,

    -- * Request Lenses
    updateContainerAgent_cluster,
    updateContainerAgent_containerInstance,

    -- * Destructuring the Response
    UpdateContainerAgentResponse (..),
    newUpdateContainerAgentResponse,

    -- * Response Lenses
    updateContainerAgentResponse_containerInstance,
    updateContainerAgentResponse_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:/ 'newUpdateContainerAgent' smart constructor.
data UpdateContainerAgent = UpdateContainerAgent'
  { -- | The short name or full Amazon Resource Name (ARN) of the cluster that
    -- your container instance is running on. If you do not specify a cluster,
    -- the default cluster is assumed.
    UpdateContainerAgent -> Maybe Text
cluster :: Prelude.Maybe Prelude.Text,
    -- | The container instance ID or full ARN entries for the container instance
    -- where you would like to update the Amazon ECS container agent.
    UpdateContainerAgent -> Text
containerInstance :: Prelude.Text
  }
  deriving (UpdateContainerAgent -> UpdateContainerAgent -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UpdateContainerAgent -> UpdateContainerAgent -> Bool
$c/= :: UpdateContainerAgent -> UpdateContainerAgent -> Bool
== :: UpdateContainerAgent -> UpdateContainerAgent -> Bool
$c== :: UpdateContainerAgent -> UpdateContainerAgent -> Bool
Prelude.Eq, ReadPrec [UpdateContainerAgent]
ReadPrec UpdateContainerAgent
Int -> ReadS UpdateContainerAgent
ReadS [UpdateContainerAgent]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [UpdateContainerAgent]
$creadListPrec :: ReadPrec [UpdateContainerAgent]
readPrec :: ReadPrec UpdateContainerAgent
$creadPrec :: ReadPrec UpdateContainerAgent
readList :: ReadS [UpdateContainerAgent]
$creadList :: ReadS [UpdateContainerAgent]
readsPrec :: Int -> ReadS UpdateContainerAgent
$creadsPrec :: Int -> ReadS UpdateContainerAgent
Prelude.Read, Int -> UpdateContainerAgent -> ShowS
[UpdateContainerAgent] -> ShowS
UpdateContainerAgent -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UpdateContainerAgent] -> ShowS
$cshowList :: [UpdateContainerAgent] -> ShowS
show :: UpdateContainerAgent -> String
$cshow :: UpdateContainerAgent -> String
showsPrec :: Int -> UpdateContainerAgent -> ShowS
$cshowsPrec :: Int -> UpdateContainerAgent -> ShowS
Prelude.Show, forall x. Rep UpdateContainerAgent x -> UpdateContainerAgent
forall x. UpdateContainerAgent -> Rep UpdateContainerAgent x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep UpdateContainerAgent x -> UpdateContainerAgent
$cfrom :: forall x. UpdateContainerAgent -> Rep UpdateContainerAgent x
Prelude.Generic)

-- |
-- Create a value of 'UpdateContainerAgent' 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', 'updateContainerAgent_cluster' - The short name or full Amazon Resource Name (ARN) of the cluster that
-- your container instance is running on. If you do not specify a cluster,
-- the default cluster is assumed.
--
-- 'containerInstance', 'updateContainerAgent_containerInstance' - The container instance ID or full ARN entries for the container instance
-- where you would like to update the Amazon ECS container agent.
newUpdateContainerAgent ::
  -- | 'containerInstance'
  Prelude.Text ->
  UpdateContainerAgent
newUpdateContainerAgent :: Text -> UpdateContainerAgent
newUpdateContainerAgent Text
pContainerInstance_ =
  UpdateContainerAgent'
    { $sel:cluster:UpdateContainerAgent' :: Maybe Text
cluster = forall a. Maybe a
Prelude.Nothing,
      $sel:containerInstance:UpdateContainerAgent' :: Text
containerInstance = Text
pContainerInstance_
    }

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

-- | The container instance ID or full ARN entries for the container instance
-- where you would like to update the Amazon ECS container agent.
updateContainerAgent_containerInstance :: Lens.Lens' UpdateContainerAgent Prelude.Text
updateContainerAgent_containerInstance :: Lens' UpdateContainerAgent Text
updateContainerAgent_containerInstance = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateContainerAgent' {Text
containerInstance :: Text
$sel:containerInstance:UpdateContainerAgent' :: UpdateContainerAgent -> Text
containerInstance} -> Text
containerInstance) (\s :: UpdateContainerAgent
s@UpdateContainerAgent' {} Text
a -> UpdateContainerAgent
s {$sel:containerInstance:UpdateContainerAgent' :: Text
containerInstance = Text
a} :: UpdateContainerAgent)

instance Core.AWSRequest UpdateContainerAgent where
  type
    AWSResponse UpdateContainerAgent =
      UpdateContainerAgentResponse
  request :: (Service -> Service)
-> UpdateContainerAgent -> Request UpdateContainerAgent
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 UpdateContainerAgent
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse UpdateContainerAgent)))
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 -> Int -> UpdateContainerAgentResponse
UpdateContainerAgentResponse'
            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
"containerInstance")
            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 UpdateContainerAgent where
  hashWithSalt :: Int -> UpdateContainerAgent -> Int
hashWithSalt Int
_salt UpdateContainerAgent' {Maybe Text
Text
containerInstance :: Text
cluster :: Maybe Text
$sel:containerInstance:UpdateContainerAgent' :: UpdateContainerAgent -> Text
$sel:cluster:UpdateContainerAgent' :: UpdateContainerAgent -> 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
containerInstance

instance Prelude.NFData UpdateContainerAgent where
  rnf :: UpdateContainerAgent -> ()
rnf UpdateContainerAgent' {Maybe Text
Text
containerInstance :: Text
cluster :: Maybe Text
$sel:containerInstance:UpdateContainerAgent' :: UpdateContainerAgent -> Text
$sel:cluster:UpdateContainerAgent' :: UpdateContainerAgent -> 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
containerInstance

instance Data.ToHeaders UpdateContainerAgent where
  toHeaders :: UpdateContainerAgent -> 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.UpdateContainerAgent" ::
                          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 UpdateContainerAgent where
  toJSON :: UpdateContainerAgent -> Value
toJSON UpdateContainerAgent' {Maybe Text
Text
containerInstance :: Text
cluster :: Maybe Text
$sel:containerInstance:UpdateContainerAgent' :: UpdateContainerAgent -> Text
$sel:cluster:UpdateContainerAgent' :: UpdateContainerAgent -> 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
"containerInstance" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
containerInstance)
          ]
      )

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

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

-- | /See:/ 'newUpdateContainerAgentResponse' smart constructor.
data UpdateContainerAgentResponse = UpdateContainerAgentResponse'
  { -- | The container instance that the container agent was updated for.
    UpdateContainerAgentResponse -> Maybe ContainerInstance
containerInstance :: Prelude.Maybe ContainerInstance,
    -- | The response's http status code.
    UpdateContainerAgentResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (UpdateContainerAgentResponse
-> UpdateContainerAgentResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UpdateContainerAgentResponse
-> UpdateContainerAgentResponse -> Bool
$c/= :: UpdateContainerAgentResponse
-> UpdateContainerAgentResponse -> Bool
== :: UpdateContainerAgentResponse
-> UpdateContainerAgentResponse -> Bool
$c== :: UpdateContainerAgentResponse
-> UpdateContainerAgentResponse -> Bool
Prelude.Eq, ReadPrec [UpdateContainerAgentResponse]
ReadPrec UpdateContainerAgentResponse
Int -> ReadS UpdateContainerAgentResponse
ReadS [UpdateContainerAgentResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [UpdateContainerAgentResponse]
$creadListPrec :: ReadPrec [UpdateContainerAgentResponse]
readPrec :: ReadPrec UpdateContainerAgentResponse
$creadPrec :: ReadPrec UpdateContainerAgentResponse
readList :: ReadS [UpdateContainerAgentResponse]
$creadList :: ReadS [UpdateContainerAgentResponse]
readsPrec :: Int -> ReadS UpdateContainerAgentResponse
$creadsPrec :: Int -> ReadS UpdateContainerAgentResponse
Prelude.Read, Int -> UpdateContainerAgentResponse -> ShowS
[UpdateContainerAgentResponse] -> ShowS
UpdateContainerAgentResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UpdateContainerAgentResponse] -> ShowS
$cshowList :: [UpdateContainerAgentResponse] -> ShowS
show :: UpdateContainerAgentResponse -> String
$cshow :: UpdateContainerAgentResponse -> String
showsPrec :: Int -> UpdateContainerAgentResponse -> ShowS
$cshowsPrec :: Int -> UpdateContainerAgentResponse -> ShowS
Prelude.Show, forall x.
Rep UpdateContainerAgentResponse x -> UpdateContainerAgentResponse
forall x.
UpdateContainerAgentResponse -> Rep UpdateContainerAgentResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep UpdateContainerAgentResponse x -> UpdateContainerAgentResponse
$cfrom :: forall x.
UpdateContainerAgentResponse -> Rep UpdateContainerAgentResponse x
Prelude.Generic)

-- |
-- Create a value of 'UpdateContainerAgentResponse' 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:
--
-- 'containerInstance', 'updateContainerAgentResponse_containerInstance' - The container instance that the container agent was updated for.
--
-- 'httpStatus', 'updateContainerAgentResponse_httpStatus' - The response's http status code.
newUpdateContainerAgentResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  UpdateContainerAgentResponse
newUpdateContainerAgentResponse :: Int -> UpdateContainerAgentResponse
newUpdateContainerAgentResponse Int
pHttpStatus_ =
  UpdateContainerAgentResponse'
    { $sel:containerInstance:UpdateContainerAgentResponse' :: Maybe ContainerInstance
containerInstance =
        forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:UpdateContainerAgentResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | The container instance that the container agent was updated for.
updateContainerAgentResponse_containerInstance :: Lens.Lens' UpdateContainerAgentResponse (Prelude.Maybe ContainerInstance)
updateContainerAgentResponse_containerInstance :: Lens' UpdateContainerAgentResponse (Maybe ContainerInstance)
updateContainerAgentResponse_containerInstance = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateContainerAgentResponse' {Maybe ContainerInstance
containerInstance :: Maybe ContainerInstance
$sel:containerInstance:UpdateContainerAgentResponse' :: UpdateContainerAgentResponse -> Maybe ContainerInstance
containerInstance} -> Maybe ContainerInstance
containerInstance) (\s :: UpdateContainerAgentResponse
s@UpdateContainerAgentResponse' {} Maybe ContainerInstance
a -> UpdateContainerAgentResponse
s {$sel:containerInstance:UpdateContainerAgentResponse' :: Maybe ContainerInstance
containerInstance = Maybe ContainerInstance
a} :: UpdateContainerAgentResponse)

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

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