{-# 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.ElasticBeanstalk.UpdateApplicationVersion
-- 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 specified application version to have the specified
-- properties.
--
-- If a property (for example, @description@) is not provided, the value
-- remains unchanged. To clear properties, specify an empty string.
module Amazonka.ElasticBeanstalk.UpdateApplicationVersion
  ( -- * Creating a Request
    UpdateApplicationVersion (..),
    newUpdateApplicationVersion,

    -- * Request Lenses
    updateApplicationVersion_description,
    updateApplicationVersion_applicationName,
    updateApplicationVersion_versionLabel,

    -- * Destructuring the Response
    ApplicationVersionDescriptionMessage (..),
    newApplicationVersionDescriptionMessage,

    -- * Response Lenses
    applicationVersionDescriptionMessage_applicationVersion,
  )
where

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

-- |
--
-- /See:/ 'newUpdateApplicationVersion' smart constructor.
data UpdateApplicationVersion = UpdateApplicationVersion'
  { -- | A new description for this version.
    UpdateApplicationVersion -> Maybe Text
description :: Prelude.Maybe Prelude.Text,
    -- | The name of the application associated with this version.
    --
    -- If no application is found with this name, @UpdateApplication@ returns
    -- an @InvalidParameterValue@ error.
    UpdateApplicationVersion -> Text
applicationName :: Prelude.Text,
    -- | The name of the version to update.
    --
    -- If no application version is found with this label, @UpdateApplication@
    -- returns an @InvalidParameterValue@ error.
    UpdateApplicationVersion -> Text
versionLabel :: Prelude.Text
  }
  deriving (UpdateApplicationVersion -> UpdateApplicationVersion -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UpdateApplicationVersion -> UpdateApplicationVersion -> Bool
$c/= :: UpdateApplicationVersion -> UpdateApplicationVersion -> Bool
== :: UpdateApplicationVersion -> UpdateApplicationVersion -> Bool
$c== :: UpdateApplicationVersion -> UpdateApplicationVersion -> Bool
Prelude.Eq, ReadPrec [UpdateApplicationVersion]
ReadPrec UpdateApplicationVersion
Int -> ReadS UpdateApplicationVersion
ReadS [UpdateApplicationVersion]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [UpdateApplicationVersion]
$creadListPrec :: ReadPrec [UpdateApplicationVersion]
readPrec :: ReadPrec UpdateApplicationVersion
$creadPrec :: ReadPrec UpdateApplicationVersion
readList :: ReadS [UpdateApplicationVersion]
$creadList :: ReadS [UpdateApplicationVersion]
readsPrec :: Int -> ReadS UpdateApplicationVersion
$creadsPrec :: Int -> ReadS UpdateApplicationVersion
Prelude.Read, Int -> UpdateApplicationVersion -> ShowS
[UpdateApplicationVersion] -> ShowS
UpdateApplicationVersion -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UpdateApplicationVersion] -> ShowS
$cshowList :: [UpdateApplicationVersion] -> ShowS
show :: UpdateApplicationVersion -> String
$cshow :: UpdateApplicationVersion -> String
showsPrec :: Int -> UpdateApplicationVersion -> ShowS
$cshowsPrec :: Int -> UpdateApplicationVersion -> ShowS
Prelude.Show, forall x.
Rep UpdateApplicationVersion x -> UpdateApplicationVersion
forall x.
UpdateApplicationVersion -> Rep UpdateApplicationVersion x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep UpdateApplicationVersion x -> UpdateApplicationVersion
$cfrom :: forall x.
UpdateApplicationVersion -> Rep UpdateApplicationVersion x
Prelude.Generic)

-- |
-- Create a value of 'UpdateApplicationVersion' 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:
--
-- 'description', 'updateApplicationVersion_description' - A new description for this version.
--
-- 'applicationName', 'updateApplicationVersion_applicationName' - The name of the application associated with this version.
--
-- If no application is found with this name, @UpdateApplication@ returns
-- an @InvalidParameterValue@ error.
--
-- 'versionLabel', 'updateApplicationVersion_versionLabel' - The name of the version to update.
--
-- If no application version is found with this label, @UpdateApplication@
-- returns an @InvalidParameterValue@ error.
newUpdateApplicationVersion ::
  -- | 'applicationName'
  Prelude.Text ->
  -- | 'versionLabel'
  Prelude.Text ->
  UpdateApplicationVersion
newUpdateApplicationVersion :: Text -> Text -> UpdateApplicationVersion
newUpdateApplicationVersion
  Text
pApplicationName_
  Text
pVersionLabel_ =
    UpdateApplicationVersion'
      { $sel:description:UpdateApplicationVersion' :: Maybe Text
description =
          forall a. Maybe a
Prelude.Nothing,
        $sel:applicationName:UpdateApplicationVersion' :: Text
applicationName = Text
pApplicationName_,
        $sel:versionLabel:UpdateApplicationVersion' :: Text
versionLabel = Text
pVersionLabel_
      }

-- | A new description for this version.
updateApplicationVersion_description :: Lens.Lens' UpdateApplicationVersion (Prelude.Maybe Prelude.Text)
updateApplicationVersion_description :: Lens' UpdateApplicationVersion (Maybe Text)
updateApplicationVersion_description = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateApplicationVersion' {Maybe Text
description :: Maybe Text
$sel:description:UpdateApplicationVersion' :: UpdateApplicationVersion -> Maybe Text
description} -> Maybe Text
description) (\s :: UpdateApplicationVersion
s@UpdateApplicationVersion' {} Maybe Text
a -> UpdateApplicationVersion
s {$sel:description:UpdateApplicationVersion' :: Maybe Text
description = Maybe Text
a} :: UpdateApplicationVersion)

-- | The name of the application associated with this version.
--
-- If no application is found with this name, @UpdateApplication@ returns
-- an @InvalidParameterValue@ error.
updateApplicationVersion_applicationName :: Lens.Lens' UpdateApplicationVersion Prelude.Text
updateApplicationVersion_applicationName :: Lens' UpdateApplicationVersion Text
updateApplicationVersion_applicationName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateApplicationVersion' {Text
applicationName :: Text
$sel:applicationName:UpdateApplicationVersion' :: UpdateApplicationVersion -> Text
applicationName} -> Text
applicationName) (\s :: UpdateApplicationVersion
s@UpdateApplicationVersion' {} Text
a -> UpdateApplicationVersion
s {$sel:applicationName:UpdateApplicationVersion' :: Text
applicationName = Text
a} :: UpdateApplicationVersion)

-- | The name of the version to update.
--
-- If no application version is found with this label, @UpdateApplication@
-- returns an @InvalidParameterValue@ error.
updateApplicationVersion_versionLabel :: Lens.Lens' UpdateApplicationVersion Prelude.Text
updateApplicationVersion_versionLabel :: Lens' UpdateApplicationVersion Text
updateApplicationVersion_versionLabel = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateApplicationVersion' {Text
versionLabel :: Text
$sel:versionLabel:UpdateApplicationVersion' :: UpdateApplicationVersion -> Text
versionLabel} -> Text
versionLabel) (\s :: UpdateApplicationVersion
s@UpdateApplicationVersion' {} Text
a -> UpdateApplicationVersion
s {$sel:versionLabel:UpdateApplicationVersion' :: Text
versionLabel = Text
a} :: UpdateApplicationVersion)

instance Core.AWSRequest UpdateApplicationVersion where
  type
    AWSResponse UpdateApplicationVersion =
      ApplicationVersionDescriptionMessage
  request :: (Service -> Service)
-> UpdateApplicationVersion -> Request UpdateApplicationVersion
request Service -> Service
overrides =
    forall a. ToRequest a => Service -> a -> Request a
Request.postQuery (Service -> Service
overrides Service
defaultService)
  response :: forall (m :: * -> *).
MonadResource m =>
(ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy UpdateApplicationVersion
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse UpdateApplicationVersion)))
response =
    forall (m :: * -> *) a.
MonadResource m =>
Text
-> (Int
    -> ResponseHeaders -> [Node] -> Either String (AWSResponse a))
-> (ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy a
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse a)))
Response.receiveXMLWrapper
      Text
"UpdateApplicationVersionResult"
      (\Int
s ResponseHeaders
h [Node]
x -> forall a. FromXML a => [Node] -> Either String a
Data.parseXML [Node]
x)

instance Prelude.Hashable UpdateApplicationVersion where
  hashWithSalt :: Int -> UpdateApplicationVersion -> Int
hashWithSalt Int
_salt UpdateApplicationVersion' {Maybe Text
Text
versionLabel :: Text
applicationName :: Text
description :: Maybe Text
$sel:versionLabel:UpdateApplicationVersion' :: UpdateApplicationVersion -> Text
$sel:applicationName:UpdateApplicationVersion' :: UpdateApplicationVersion -> Text
$sel:description:UpdateApplicationVersion' :: UpdateApplicationVersion -> Maybe Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
description
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
applicationName
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
versionLabel

instance Prelude.NFData UpdateApplicationVersion where
  rnf :: UpdateApplicationVersion -> ()
rnf UpdateApplicationVersion' {Maybe Text
Text
versionLabel :: Text
applicationName :: Text
description :: Maybe Text
$sel:versionLabel:UpdateApplicationVersion' :: UpdateApplicationVersion -> Text
$sel:applicationName:UpdateApplicationVersion' :: UpdateApplicationVersion -> Text
$sel:description:UpdateApplicationVersion' :: UpdateApplicationVersion -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
description
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
applicationName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
versionLabel

instance Data.ToHeaders UpdateApplicationVersion where
  toHeaders :: UpdateApplicationVersion -> ResponseHeaders
toHeaders = forall a b. a -> b -> a
Prelude.const forall a. Monoid a => a
Prelude.mempty

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

instance Data.ToQuery UpdateApplicationVersion where
  toQuery :: UpdateApplicationVersion -> QueryString
toQuery UpdateApplicationVersion' {Maybe Text
Text
versionLabel :: Text
applicationName :: Text
description :: Maybe Text
$sel:versionLabel:UpdateApplicationVersion' :: UpdateApplicationVersion -> Text
$sel:applicationName:UpdateApplicationVersion' :: UpdateApplicationVersion -> Text
$sel:description:UpdateApplicationVersion' :: UpdateApplicationVersion -> Maybe Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"Action"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: (ByteString
"UpdateApplicationVersion" :: Prelude.ByteString),
        ByteString
"Version"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: (ByteString
"2010-12-01" :: Prelude.ByteString),
        ByteString
"Description" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Text
description,
        ByteString
"ApplicationName" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Text
applicationName,
        ByteString
"VersionLabel" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Text
versionLabel
      ]