{-# 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.EKS.DescribeUpdate
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Returns descriptive information about an update against your Amazon EKS
-- cluster or associated managed node group or Amazon EKS add-on.
--
-- When the status of the update is @Succeeded@, the update is complete. If
-- an update fails, the status is @Failed@, and an error detail explains
-- the reason for the failure.
module Amazonka.EKS.DescribeUpdate
  ( -- * Creating a Request
    DescribeUpdate (..),
    newDescribeUpdate,

    -- * Request Lenses
    describeUpdate_addonName,
    describeUpdate_nodegroupName,
    describeUpdate_name,
    describeUpdate_updateId,

    -- * Destructuring the Response
    DescribeUpdateResponse (..),
    newDescribeUpdateResponse,

    -- * Response Lenses
    describeUpdateResponse_update,
    describeUpdateResponse_httpStatus,
  )
where

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

-- | /See:/ 'newDescribeUpdate' smart constructor.
data DescribeUpdate = DescribeUpdate'
  { -- | The name of the add-on. The name must match one of the names returned by
    -- <https://docs.aws.amazon.com/eks/latest/APIReference/API_ListAddons.html ListAddons>
    -- . This parameter is required if the update is an add-on update.
    DescribeUpdate -> Maybe Text
addonName :: Prelude.Maybe Prelude.Text,
    -- | The name of the Amazon EKS node group associated with the update. This
    -- parameter is required if the update is a node group update.
    DescribeUpdate -> Maybe Text
nodegroupName :: Prelude.Maybe Prelude.Text,
    -- | The name of the Amazon EKS cluster associated with the update.
    DescribeUpdate -> Text
name :: Prelude.Text,
    -- | The ID of the update to describe.
    DescribeUpdate -> Text
updateId :: Prelude.Text
  }
  deriving (DescribeUpdate -> DescribeUpdate -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DescribeUpdate -> DescribeUpdate -> Bool
$c/= :: DescribeUpdate -> DescribeUpdate -> Bool
== :: DescribeUpdate -> DescribeUpdate -> Bool
$c== :: DescribeUpdate -> DescribeUpdate -> Bool
Prelude.Eq, ReadPrec [DescribeUpdate]
ReadPrec DescribeUpdate
Int -> ReadS DescribeUpdate
ReadS [DescribeUpdate]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DescribeUpdate]
$creadListPrec :: ReadPrec [DescribeUpdate]
readPrec :: ReadPrec DescribeUpdate
$creadPrec :: ReadPrec DescribeUpdate
readList :: ReadS [DescribeUpdate]
$creadList :: ReadS [DescribeUpdate]
readsPrec :: Int -> ReadS DescribeUpdate
$creadsPrec :: Int -> ReadS DescribeUpdate
Prelude.Read, Int -> DescribeUpdate -> ShowS
[DescribeUpdate] -> ShowS
DescribeUpdate -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DescribeUpdate] -> ShowS
$cshowList :: [DescribeUpdate] -> ShowS
show :: DescribeUpdate -> String
$cshow :: DescribeUpdate -> String
showsPrec :: Int -> DescribeUpdate -> ShowS
$cshowsPrec :: Int -> DescribeUpdate -> ShowS
Prelude.Show, forall x. Rep DescribeUpdate x -> DescribeUpdate
forall x. DescribeUpdate -> Rep DescribeUpdate x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep DescribeUpdate x -> DescribeUpdate
$cfrom :: forall x. DescribeUpdate -> Rep DescribeUpdate x
Prelude.Generic)

-- |
-- Create a value of 'DescribeUpdate' 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:
--
-- 'addonName', 'describeUpdate_addonName' - The name of the add-on. The name must match one of the names returned by
-- <https://docs.aws.amazon.com/eks/latest/APIReference/API_ListAddons.html ListAddons>
-- . This parameter is required if the update is an add-on update.
--
-- 'nodegroupName', 'describeUpdate_nodegroupName' - The name of the Amazon EKS node group associated with the update. This
-- parameter is required if the update is a node group update.
--
-- 'name', 'describeUpdate_name' - The name of the Amazon EKS cluster associated with the update.
--
-- 'updateId', 'describeUpdate_updateId' - The ID of the update to describe.
newDescribeUpdate ::
  -- | 'name'
  Prelude.Text ->
  -- | 'updateId'
  Prelude.Text ->
  DescribeUpdate
newDescribeUpdate :: Text -> Text -> DescribeUpdate
newDescribeUpdate Text
pName_ Text
pUpdateId_ =
  DescribeUpdate'
    { $sel:addonName:DescribeUpdate' :: Maybe Text
addonName = forall a. Maybe a
Prelude.Nothing,
      $sel:nodegroupName:DescribeUpdate' :: Maybe Text
nodegroupName = forall a. Maybe a
Prelude.Nothing,
      $sel:name:DescribeUpdate' :: Text
name = Text
pName_,
      $sel:updateId:DescribeUpdate' :: Text
updateId = Text
pUpdateId_
    }

-- | The name of the add-on. The name must match one of the names returned by
-- <https://docs.aws.amazon.com/eks/latest/APIReference/API_ListAddons.html ListAddons>
-- . This parameter is required if the update is an add-on update.
describeUpdate_addonName :: Lens.Lens' DescribeUpdate (Prelude.Maybe Prelude.Text)
describeUpdate_addonName :: Lens' DescribeUpdate (Maybe Text)
describeUpdate_addonName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeUpdate' {Maybe Text
addonName :: Maybe Text
$sel:addonName:DescribeUpdate' :: DescribeUpdate -> Maybe Text
addonName} -> Maybe Text
addonName) (\s :: DescribeUpdate
s@DescribeUpdate' {} Maybe Text
a -> DescribeUpdate
s {$sel:addonName:DescribeUpdate' :: Maybe Text
addonName = Maybe Text
a} :: DescribeUpdate)

-- | The name of the Amazon EKS node group associated with the update. This
-- parameter is required if the update is a node group update.
describeUpdate_nodegroupName :: Lens.Lens' DescribeUpdate (Prelude.Maybe Prelude.Text)
describeUpdate_nodegroupName :: Lens' DescribeUpdate (Maybe Text)
describeUpdate_nodegroupName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeUpdate' {Maybe Text
nodegroupName :: Maybe Text
$sel:nodegroupName:DescribeUpdate' :: DescribeUpdate -> Maybe Text
nodegroupName} -> Maybe Text
nodegroupName) (\s :: DescribeUpdate
s@DescribeUpdate' {} Maybe Text
a -> DescribeUpdate
s {$sel:nodegroupName:DescribeUpdate' :: Maybe Text
nodegroupName = Maybe Text
a} :: DescribeUpdate)

-- | The name of the Amazon EKS cluster associated with the update.
describeUpdate_name :: Lens.Lens' DescribeUpdate Prelude.Text
describeUpdate_name :: Lens' DescribeUpdate Text
describeUpdate_name = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeUpdate' {Text
name :: Text
$sel:name:DescribeUpdate' :: DescribeUpdate -> Text
name} -> Text
name) (\s :: DescribeUpdate
s@DescribeUpdate' {} Text
a -> DescribeUpdate
s {$sel:name:DescribeUpdate' :: Text
name = Text
a} :: DescribeUpdate)

-- | The ID of the update to describe.
describeUpdate_updateId :: Lens.Lens' DescribeUpdate Prelude.Text
describeUpdate_updateId :: Lens' DescribeUpdate Text
describeUpdate_updateId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeUpdate' {Text
updateId :: Text
$sel:updateId:DescribeUpdate' :: DescribeUpdate -> Text
updateId} -> Text
updateId) (\s :: DescribeUpdate
s@DescribeUpdate' {} Text
a -> DescribeUpdate
s {$sel:updateId:DescribeUpdate' :: Text
updateId = Text
a} :: DescribeUpdate)

instance Core.AWSRequest DescribeUpdate where
  type
    AWSResponse DescribeUpdate =
      DescribeUpdateResponse
  request :: (Service -> Service) -> DescribeUpdate -> Request DescribeUpdate
request Service -> Service
overrides =
    forall a. ToRequest a => Service -> a -> Request a
Request.get (Service -> Service
overrides Service
defaultService)
  response :: forall (m :: * -> *).
MonadResource m =>
(ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy DescribeUpdate
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse DescribeUpdate)))
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 Update -> Int -> DescribeUpdateResponse
DescribeUpdateResponse'
            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
"update")
            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 DescribeUpdate where
  hashWithSalt :: Int -> DescribeUpdate -> Int
hashWithSalt Int
_salt DescribeUpdate' {Maybe Text
Text
updateId :: Text
name :: Text
nodegroupName :: Maybe Text
addonName :: Maybe Text
$sel:updateId:DescribeUpdate' :: DescribeUpdate -> Text
$sel:name:DescribeUpdate' :: DescribeUpdate -> Text
$sel:nodegroupName:DescribeUpdate' :: DescribeUpdate -> Maybe Text
$sel:addonName:DescribeUpdate' :: DescribeUpdate -> Maybe Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
addonName
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
nodegroupName
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
name
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
updateId

instance Prelude.NFData DescribeUpdate where
  rnf :: DescribeUpdate -> ()
rnf DescribeUpdate' {Maybe Text
Text
updateId :: Text
name :: Text
nodegroupName :: Maybe Text
addonName :: Maybe Text
$sel:updateId:DescribeUpdate' :: DescribeUpdate -> Text
$sel:name:DescribeUpdate' :: DescribeUpdate -> Text
$sel:nodegroupName:DescribeUpdate' :: DescribeUpdate -> Maybe Text
$sel:addonName:DescribeUpdate' :: DescribeUpdate -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
addonName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
nodegroupName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
name
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
updateId

instance Data.ToHeaders DescribeUpdate where
  toHeaders :: DescribeUpdate -> ResponseHeaders
toHeaders =
    forall a b. a -> b -> a
Prelude.const
      ( forall a. Monoid a => [a] -> a
Prelude.mconcat
          [ HeaderName
"Content-Type"
              forall a. ToHeader a => HeaderName -> a -> ResponseHeaders
Data.=# ( ByteString
"application/x-amz-json-1.1" ::
                          Prelude.ByteString
                      )
          ]
      )

instance Data.ToPath DescribeUpdate where
  toPath :: DescribeUpdate -> ByteString
toPath DescribeUpdate' {Maybe Text
Text
updateId :: Text
name :: Text
nodegroupName :: Maybe Text
addonName :: Maybe Text
$sel:updateId:DescribeUpdate' :: DescribeUpdate -> Text
$sel:name:DescribeUpdate' :: DescribeUpdate -> Text
$sel:nodegroupName:DescribeUpdate' :: DescribeUpdate -> Maybe Text
$sel:addonName:DescribeUpdate' :: DescribeUpdate -> Maybe Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"/clusters/",
        forall a. ToByteString a => a -> ByteString
Data.toBS Text
name,
        ByteString
"/updates/",
        forall a. ToByteString a => a -> ByteString
Data.toBS Text
updateId
      ]

instance Data.ToQuery DescribeUpdate where
  toQuery :: DescribeUpdate -> QueryString
toQuery DescribeUpdate' {Maybe Text
Text
updateId :: Text
name :: Text
nodegroupName :: Maybe Text
addonName :: Maybe Text
$sel:updateId:DescribeUpdate' :: DescribeUpdate -> Text
$sel:name:DescribeUpdate' :: DescribeUpdate -> Text
$sel:nodegroupName:DescribeUpdate' :: DescribeUpdate -> Maybe Text
$sel:addonName:DescribeUpdate' :: DescribeUpdate -> Maybe Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"addonName" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Text
addonName,
        ByteString
"nodegroupName" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Text
nodegroupName
      ]

-- | /See:/ 'newDescribeUpdateResponse' smart constructor.
data DescribeUpdateResponse = DescribeUpdateResponse'
  { -- | The full description of the specified update.
    DescribeUpdateResponse -> Maybe Update
update :: Prelude.Maybe Update,
    -- | The response's http status code.
    DescribeUpdateResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (DescribeUpdateResponse -> DescribeUpdateResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DescribeUpdateResponse -> DescribeUpdateResponse -> Bool
$c/= :: DescribeUpdateResponse -> DescribeUpdateResponse -> Bool
== :: DescribeUpdateResponse -> DescribeUpdateResponse -> Bool
$c== :: DescribeUpdateResponse -> DescribeUpdateResponse -> Bool
Prelude.Eq, ReadPrec [DescribeUpdateResponse]
ReadPrec DescribeUpdateResponse
Int -> ReadS DescribeUpdateResponse
ReadS [DescribeUpdateResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DescribeUpdateResponse]
$creadListPrec :: ReadPrec [DescribeUpdateResponse]
readPrec :: ReadPrec DescribeUpdateResponse
$creadPrec :: ReadPrec DescribeUpdateResponse
readList :: ReadS [DescribeUpdateResponse]
$creadList :: ReadS [DescribeUpdateResponse]
readsPrec :: Int -> ReadS DescribeUpdateResponse
$creadsPrec :: Int -> ReadS DescribeUpdateResponse
Prelude.Read, Int -> DescribeUpdateResponse -> ShowS
[DescribeUpdateResponse] -> ShowS
DescribeUpdateResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DescribeUpdateResponse] -> ShowS
$cshowList :: [DescribeUpdateResponse] -> ShowS
show :: DescribeUpdateResponse -> String
$cshow :: DescribeUpdateResponse -> String
showsPrec :: Int -> DescribeUpdateResponse -> ShowS
$cshowsPrec :: Int -> DescribeUpdateResponse -> ShowS
Prelude.Show, forall x. Rep DescribeUpdateResponse x -> DescribeUpdateResponse
forall x. DescribeUpdateResponse -> Rep DescribeUpdateResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep DescribeUpdateResponse x -> DescribeUpdateResponse
$cfrom :: forall x. DescribeUpdateResponse -> Rep DescribeUpdateResponse x
Prelude.Generic)

-- |
-- Create a value of 'DescribeUpdateResponse' 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:
--
-- 'update', 'describeUpdateResponse_update' - The full description of the specified update.
--
-- 'httpStatus', 'describeUpdateResponse_httpStatus' - The response's http status code.
newDescribeUpdateResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  DescribeUpdateResponse
newDescribeUpdateResponse :: Int -> DescribeUpdateResponse
newDescribeUpdateResponse Int
pHttpStatus_ =
  DescribeUpdateResponse'
    { $sel:update:DescribeUpdateResponse' :: Maybe Update
update = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:DescribeUpdateResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | The full description of the specified update.
describeUpdateResponse_update :: Lens.Lens' DescribeUpdateResponse (Prelude.Maybe Update)
describeUpdateResponse_update :: Lens' DescribeUpdateResponse (Maybe Update)
describeUpdateResponse_update = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeUpdateResponse' {Maybe Update
update :: Maybe Update
$sel:update:DescribeUpdateResponse' :: DescribeUpdateResponse -> Maybe Update
update} -> Maybe Update
update) (\s :: DescribeUpdateResponse
s@DescribeUpdateResponse' {} Maybe Update
a -> DescribeUpdateResponse
s {$sel:update:DescribeUpdateResponse' :: Maybe Update
update = Maybe Update
a} :: DescribeUpdateResponse)

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

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