{-# 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.DeleteApplicationVersion
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Deletes the specified version from the specified application.
--
-- You cannot delete an application version that is associated with a
-- running environment.
module Amazonka.ElasticBeanstalk.DeleteApplicationVersion
  ( -- * Creating a Request
    DeleteApplicationVersion (..),
    newDeleteApplicationVersion,

    -- * Request Lenses
    deleteApplicationVersion_deleteSourceBundle,
    deleteApplicationVersion_applicationName,
    deleteApplicationVersion_versionLabel,

    -- * Destructuring the Response
    DeleteApplicationVersionResponse (..),
    newDeleteApplicationVersionResponse,
  )
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

-- | Request to delete an application version.
--
-- /See:/ 'newDeleteApplicationVersion' smart constructor.
data DeleteApplicationVersion = DeleteApplicationVersion'
  { -- | Set to @true@ to delete the source bundle from your storage bucket.
    -- Otherwise, the application version is deleted only from Elastic
    -- Beanstalk and the source bundle remains in Amazon S3.
    DeleteApplicationVersion -> Maybe Bool
deleteSourceBundle :: Prelude.Maybe Prelude.Bool,
    -- | The name of the application to which the version belongs.
    DeleteApplicationVersion -> Text
applicationName :: Prelude.Text,
    -- | The label of the version to delete.
    DeleteApplicationVersion -> Text
versionLabel :: Prelude.Text
  }
  deriving (DeleteApplicationVersion -> DeleteApplicationVersion -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DeleteApplicationVersion -> DeleteApplicationVersion -> Bool
$c/= :: DeleteApplicationVersion -> DeleteApplicationVersion -> Bool
== :: DeleteApplicationVersion -> DeleteApplicationVersion -> Bool
$c== :: DeleteApplicationVersion -> DeleteApplicationVersion -> Bool
Prelude.Eq, ReadPrec [DeleteApplicationVersion]
ReadPrec DeleteApplicationVersion
Int -> ReadS DeleteApplicationVersion
ReadS [DeleteApplicationVersion]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DeleteApplicationVersion]
$creadListPrec :: ReadPrec [DeleteApplicationVersion]
readPrec :: ReadPrec DeleteApplicationVersion
$creadPrec :: ReadPrec DeleteApplicationVersion
readList :: ReadS [DeleteApplicationVersion]
$creadList :: ReadS [DeleteApplicationVersion]
readsPrec :: Int -> ReadS DeleteApplicationVersion
$creadsPrec :: Int -> ReadS DeleteApplicationVersion
Prelude.Read, Int -> DeleteApplicationVersion -> ShowS
[DeleteApplicationVersion] -> ShowS
DeleteApplicationVersion -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DeleteApplicationVersion] -> ShowS
$cshowList :: [DeleteApplicationVersion] -> ShowS
show :: DeleteApplicationVersion -> String
$cshow :: DeleteApplicationVersion -> String
showsPrec :: Int -> DeleteApplicationVersion -> ShowS
$cshowsPrec :: Int -> DeleteApplicationVersion -> ShowS
Prelude.Show, forall x.
Rep DeleteApplicationVersion x -> DeleteApplicationVersion
forall x.
DeleteApplicationVersion -> Rep DeleteApplicationVersion x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep DeleteApplicationVersion x -> DeleteApplicationVersion
$cfrom :: forall x.
DeleteApplicationVersion -> Rep DeleteApplicationVersion x
Prelude.Generic)

-- |
-- Create a value of 'DeleteApplicationVersion' 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:
--
-- 'deleteSourceBundle', 'deleteApplicationVersion_deleteSourceBundle' - Set to @true@ to delete the source bundle from your storage bucket.
-- Otherwise, the application version is deleted only from Elastic
-- Beanstalk and the source bundle remains in Amazon S3.
--
-- 'applicationName', 'deleteApplicationVersion_applicationName' - The name of the application to which the version belongs.
--
-- 'versionLabel', 'deleteApplicationVersion_versionLabel' - The label of the version to delete.
newDeleteApplicationVersion ::
  -- | 'applicationName'
  Prelude.Text ->
  -- | 'versionLabel'
  Prelude.Text ->
  DeleteApplicationVersion
newDeleteApplicationVersion :: Text -> Text -> DeleteApplicationVersion
newDeleteApplicationVersion
  Text
pApplicationName_
  Text
pVersionLabel_ =
    DeleteApplicationVersion'
      { $sel:deleteSourceBundle:DeleteApplicationVersion' :: Maybe Bool
deleteSourceBundle =
          forall a. Maybe a
Prelude.Nothing,
        $sel:applicationName:DeleteApplicationVersion' :: Text
applicationName = Text
pApplicationName_,
        $sel:versionLabel:DeleteApplicationVersion' :: Text
versionLabel = Text
pVersionLabel_
      }

-- | Set to @true@ to delete the source bundle from your storage bucket.
-- Otherwise, the application version is deleted only from Elastic
-- Beanstalk and the source bundle remains in Amazon S3.
deleteApplicationVersion_deleteSourceBundle :: Lens.Lens' DeleteApplicationVersion (Prelude.Maybe Prelude.Bool)
deleteApplicationVersion_deleteSourceBundle :: Lens' DeleteApplicationVersion (Maybe Bool)
deleteApplicationVersion_deleteSourceBundle = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DeleteApplicationVersion' {Maybe Bool
deleteSourceBundle :: Maybe Bool
$sel:deleteSourceBundle:DeleteApplicationVersion' :: DeleteApplicationVersion -> Maybe Bool
deleteSourceBundle} -> Maybe Bool
deleteSourceBundle) (\s :: DeleteApplicationVersion
s@DeleteApplicationVersion' {} Maybe Bool
a -> DeleteApplicationVersion
s {$sel:deleteSourceBundle:DeleteApplicationVersion' :: Maybe Bool
deleteSourceBundle = Maybe Bool
a} :: DeleteApplicationVersion)

-- | The name of the application to which the version belongs.
deleteApplicationVersion_applicationName :: Lens.Lens' DeleteApplicationVersion Prelude.Text
deleteApplicationVersion_applicationName :: Lens' DeleteApplicationVersion Text
deleteApplicationVersion_applicationName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DeleteApplicationVersion' {Text
applicationName :: Text
$sel:applicationName:DeleteApplicationVersion' :: DeleteApplicationVersion -> Text
applicationName} -> Text
applicationName) (\s :: DeleteApplicationVersion
s@DeleteApplicationVersion' {} Text
a -> DeleteApplicationVersion
s {$sel:applicationName:DeleteApplicationVersion' :: Text
applicationName = Text
a} :: DeleteApplicationVersion)

-- | The label of the version to delete.
deleteApplicationVersion_versionLabel :: Lens.Lens' DeleteApplicationVersion Prelude.Text
deleteApplicationVersion_versionLabel :: Lens' DeleteApplicationVersion Text
deleteApplicationVersion_versionLabel = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DeleteApplicationVersion' {Text
versionLabel :: Text
$sel:versionLabel:DeleteApplicationVersion' :: DeleteApplicationVersion -> Text
versionLabel} -> Text
versionLabel) (\s :: DeleteApplicationVersion
s@DeleteApplicationVersion' {} Text
a -> DeleteApplicationVersion
s {$sel:versionLabel:DeleteApplicationVersion' :: Text
versionLabel = Text
a} :: DeleteApplicationVersion)

instance Core.AWSRequest DeleteApplicationVersion where
  type
    AWSResponse DeleteApplicationVersion =
      DeleteApplicationVersionResponse
  request :: (Service -> Service)
-> DeleteApplicationVersion -> Request DeleteApplicationVersion
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 DeleteApplicationVersion
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse DeleteApplicationVersion)))
response =
    forall (m :: * -> *) a.
MonadResource m =>
AWSResponse a
-> (ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy a
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse a)))
Response.receiveNull
      DeleteApplicationVersionResponse
DeleteApplicationVersionResponse'

instance Prelude.Hashable DeleteApplicationVersion where
  hashWithSalt :: Int -> DeleteApplicationVersion -> Int
hashWithSalt Int
_salt DeleteApplicationVersion' {Maybe Bool
Text
versionLabel :: Text
applicationName :: Text
deleteSourceBundle :: Maybe Bool
$sel:versionLabel:DeleteApplicationVersion' :: DeleteApplicationVersion -> Text
$sel:applicationName:DeleteApplicationVersion' :: DeleteApplicationVersion -> Text
$sel:deleteSourceBundle:DeleteApplicationVersion' :: DeleteApplicationVersion -> Maybe Bool
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Bool
deleteSourceBundle
      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 DeleteApplicationVersion where
  rnf :: DeleteApplicationVersion -> ()
rnf DeleteApplicationVersion' {Maybe Bool
Text
versionLabel :: Text
applicationName :: Text
deleteSourceBundle :: Maybe Bool
$sel:versionLabel:DeleteApplicationVersion' :: DeleteApplicationVersion -> Text
$sel:applicationName:DeleteApplicationVersion' :: DeleteApplicationVersion -> Text
$sel:deleteSourceBundle:DeleteApplicationVersion' :: DeleteApplicationVersion -> Maybe Bool
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Bool
deleteSourceBundle
      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 DeleteApplicationVersion where
  toHeaders :: DeleteApplicationVersion -> [Header]
toHeaders = forall a b. a -> b -> a
Prelude.const forall a. Monoid a => a
Prelude.mempty

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

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

-- | /See:/ 'newDeleteApplicationVersionResponse' smart constructor.
data DeleteApplicationVersionResponse = DeleteApplicationVersionResponse'
  {
  }
  deriving (DeleteApplicationVersionResponse
-> DeleteApplicationVersionResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DeleteApplicationVersionResponse
-> DeleteApplicationVersionResponse -> Bool
$c/= :: DeleteApplicationVersionResponse
-> DeleteApplicationVersionResponse -> Bool
== :: DeleteApplicationVersionResponse
-> DeleteApplicationVersionResponse -> Bool
$c== :: DeleteApplicationVersionResponse
-> DeleteApplicationVersionResponse -> Bool
Prelude.Eq, ReadPrec [DeleteApplicationVersionResponse]
ReadPrec DeleteApplicationVersionResponse
Int -> ReadS DeleteApplicationVersionResponse
ReadS [DeleteApplicationVersionResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DeleteApplicationVersionResponse]
$creadListPrec :: ReadPrec [DeleteApplicationVersionResponse]
readPrec :: ReadPrec DeleteApplicationVersionResponse
$creadPrec :: ReadPrec DeleteApplicationVersionResponse
readList :: ReadS [DeleteApplicationVersionResponse]
$creadList :: ReadS [DeleteApplicationVersionResponse]
readsPrec :: Int -> ReadS DeleteApplicationVersionResponse
$creadsPrec :: Int -> ReadS DeleteApplicationVersionResponse
Prelude.Read, Int -> DeleteApplicationVersionResponse -> ShowS
[DeleteApplicationVersionResponse] -> ShowS
DeleteApplicationVersionResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DeleteApplicationVersionResponse] -> ShowS
$cshowList :: [DeleteApplicationVersionResponse] -> ShowS
show :: DeleteApplicationVersionResponse -> String
$cshow :: DeleteApplicationVersionResponse -> String
showsPrec :: Int -> DeleteApplicationVersionResponse -> ShowS
$cshowsPrec :: Int -> DeleteApplicationVersionResponse -> ShowS
Prelude.Show, forall x.
Rep DeleteApplicationVersionResponse x
-> DeleteApplicationVersionResponse
forall x.
DeleteApplicationVersionResponse
-> Rep DeleteApplicationVersionResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep DeleteApplicationVersionResponse x
-> DeleteApplicationVersionResponse
$cfrom :: forall x.
DeleteApplicationVersionResponse
-> Rep DeleteApplicationVersionResponse x
Prelude.Generic)

-- |
-- Create a value of 'DeleteApplicationVersionResponse' 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.
newDeleteApplicationVersionResponse ::
  DeleteApplicationVersionResponse
newDeleteApplicationVersionResponse :: DeleteApplicationVersionResponse
newDeleteApplicationVersionResponse =
  DeleteApplicationVersionResponse
DeleteApplicationVersionResponse'

instance
  Prelude.NFData
    DeleteApplicationVersionResponse
  where
  rnf :: DeleteApplicationVersionResponse -> ()
rnf DeleteApplicationVersionResponse
_ = ()