{-# 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.DeletePlatformVersion
-- 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 of a custom platform.
module Amazonka.ElasticBeanstalk.DeletePlatformVersion
  ( -- * Creating a Request
    DeletePlatformVersion (..),
    newDeletePlatformVersion,

    -- * Request Lenses
    deletePlatformVersion_platformArn,

    -- * Destructuring the Response
    DeletePlatformVersionResponse (..),
    newDeletePlatformVersionResponse,

    -- * Response Lenses
    deletePlatformVersionResponse_platformSummary,
    deletePlatformVersionResponse_httpStatus,
  )
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:/ 'newDeletePlatformVersion' smart constructor.
data DeletePlatformVersion = DeletePlatformVersion'
  { -- | The ARN of the version of the custom platform.
    DeletePlatformVersion -> Maybe Text
platformArn :: Prelude.Maybe Prelude.Text
  }
  deriving (DeletePlatformVersion -> DeletePlatformVersion -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DeletePlatformVersion -> DeletePlatformVersion -> Bool
$c/= :: DeletePlatformVersion -> DeletePlatformVersion -> Bool
== :: DeletePlatformVersion -> DeletePlatformVersion -> Bool
$c== :: DeletePlatformVersion -> DeletePlatformVersion -> Bool
Prelude.Eq, ReadPrec [DeletePlatformVersion]
ReadPrec DeletePlatformVersion
Int -> ReadS DeletePlatformVersion
ReadS [DeletePlatformVersion]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DeletePlatformVersion]
$creadListPrec :: ReadPrec [DeletePlatformVersion]
readPrec :: ReadPrec DeletePlatformVersion
$creadPrec :: ReadPrec DeletePlatformVersion
readList :: ReadS [DeletePlatformVersion]
$creadList :: ReadS [DeletePlatformVersion]
readsPrec :: Int -> ReadS DeletePlatformVersion
$creadsPrec :: Int -> ReadS DeletePlatformVersion
Prelude.Read, Int -> DeletePlatformVersion -> ShowS
[DeletePlatformVersion] -> ShowS
DeletePlatformVersion -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DeletePlatformVersion] -> ShowS
$cshowList :: [DeletePlatformVersion] -> ShowS
show :: DeletePlatformVersion -> String
$cshow :: DeletePlatformVersion -> String
showsPrec :: Int -> DeletePlatformVersion -> ShowS
$cshowsPrec :: Int -> DeletePlatformVersion -> ShowS
Prelude.Show, forall x. Rep DeletePlatformVersion x -> DeletePlatformVersion
forall x. DeletePlatformVersion -> Rep DeletePlatformVersion x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep DeletePlatformVersion x -> DeletePlatformVersion
$cfrom :: forall x. DeletePlatformVersion -> Rep DeletePlatformVersion x
Prelude.Generic)

-- |
-- Create a value of 'DeletePlatformVersion' 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:
--
-- 'platformArn', 'deletePlatformVersion_platformArn' - The ARN of the version of the custom platform.
newDeletePlatformVersion ::
  DeletePlatformVersion
newDeletePlatformVersion :: DeletePlatformVersion
newDeletePlatformVersion =
  DeletePlatformVersion'
    { $sel:platformArn:DeletePlatformVersion' :: Maybe Text
platformArn =
        forall a. Maybe a
Prelude.Nothing
    }

-- | The ARN of the version of the custom platform.
deletePlatformVersion_platformArn :: Lens.Lens' DeletePlatformVersion (Prelude.Maybe Prelude.Text)
deletePlatformVersion_platformArn :: Lens' DeletePlatformVersion (Maybe Text)
deletePlatformVersion_platformArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DeletePlatformVersion' {Maybe Text
platformArn :: Maybe Text
$sel:platformArn:DeletePlatformVersion' :: DeletePlatformVersion -> Maybe Text
platformArn} -> Maybe Text
platformArn) (\s :: DeletePlatformVersion
s@DeletePlatformVersion' {} Maybe Text
a -> DeletePlatformVersion
s {$sel:platformArn:DeletePlatformVersion' :: Maybe Text
platformArn = Maybe Text
a} :: DeletePlatformVersion)

instance Core.AWSRequest DeletePlatformVersion where
  type
    AWSResponse DeletePlatformVersion =
      DeletePlatformVersionResponse
  request :: (Service -> Service)
-> DeletePlatformVersion -> Request DeletePlatformVersion
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 DeletePlatformVersion
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse DeletePlatformVersion)))
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
"DeletePlatformVersionResult"
      ( \Int
s ResponseHeaders
h [Node]
x ->
          Maybe PlatformSummary -> Int -> DeletePlatformVersionResponse
DeletePlatformVersionResponse'
            forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> ([Node]
x forall a. FromXML a => [Node] -> Text -> Either String (Maybe a)
Data..@? Text
"PlatformSummary")
            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 DeletePlatformVersion where
  hashWithSalt :: Int -> DeletePlatformVersion -> Int
hashWithSalt Int
_salt DeletePlatformVersion' {Maybe Text
platformArn :: Maybe Text
$sel:platformArn:DeletePlatformVersion' :: DeletePlatformVersion -> Maybe Text
..} =
    Int
_salt forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
platformArn

instance Prelude.NFData DeletePlatformVersion where
  rnf :: DeletePlatformVersion -> ()
rnf DeletePlatformVersion' {Maybe Text
platformArn :: Maybe Text
$sel:platformArn:DeletePlatformVersion' :: DeletePlatformVersion -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
platformArn

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

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

instance Data.ToQuery DeletePlatformVersion where
  toQuery :: DeletePlatformVersion -> QueryString
toQuery DeletePlatformVersion' {Maybe Text
platformArn :: Maybe Text
$sel:platformArn:DeletePlatformVersion' :: DeletePlatformVersion -> Maybe Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"Action"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: (ByteString
"DeletePlatformVersion" :: Prelude.ByteString),
        ByteString
"Version"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: (ByteString
"2010-12-01" :: Prelude.ByteString),
        ByteString
"PlatformArn" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Text
platformArn
      ]

-- | /See:/ 'newDeletePlatformVersionResponse' smart constructor.
data DeletePlatformVersionResponse = DeletePlatformVersionResponse'
  { -- | Detailed information about the version of the custom platform.
    DeletePlatformVersionResponse -> Maybe PlatformSummary
platformSummary :: Prelude.Maybe PlatformSummary,
    -- | The response's http status code.
    DeletePlatformVersionResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (DeletePlatformVersionResponse
-> DeletePlatformVersionResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DeletePlatformVersionResponse
-> DeletePlatformVersionResponse -> Bool
$c/= :: DeletePlatformVersionResponse
-> DeletePlatformVersionResponse -> Bool
== :: DeletePlatformVersionResponse
-> DeletePlatformVersionResponse -> Bool
$c== :: DeletePlatformVersionResponse
-> DeletePlatformVersionResponse -> Bool
Prelude.Eq, ReadPrec [DeletePlatformVersionResponse]
ReadPrec DeletePlatformVersionResponse
Int -> ReadS DeletePlatformVersionResponse
ReadS [DeletePlatformVersionResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DeletePlatformVersionResponse]
$creadListPrec :: ReadPrec [DeletePlatformVersionResponse]
readPrec :: ReadPrec DeletePlatformVersionResponse
$creadPrec :: ReadPrec DeletePlatformVersionResponse
readList :: ReadS [DeletePlatformVersionResponse]
$creadList :: ReadS [DeletePlatformVersionResponse]
readsPrec :: Int -> ReadS DeletePlatformVersionResponse
$creadsPrec :: Int -> ReadS DeletePlatformVersionResponse
Prelude.Read, Int -> DeletePlatformVersionResponse -> ShowS
[DeletePlatformVersionResponse] -> ShowS
DeletePlatformVersionResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DeletePlatformVersionResponse] -> ShowS
$cshowList :: [DeletePlatformVersionResponse] -> ShowS
show :: DeletePlatformVersionResponse -> String
$cshow :: DeletePlatformVersionResponse -> String
showsPrec :: Int -> DeletePlatformVersionResponse -> ShowS
$cshowsPrec :: Int -> DeletePlatformVersionResponse -> ShowS
Prelude.Show, forall x.
Rep DeletePlatformVersionResponse x
-> DeletePlatformVersionResponse
forall x.
DeletePlatformVersionResponse
-> Rep DeletePlatformVersionResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep DeletePlatformVersionResponse x
-> DeletePlatformVersionResponse
$cfrom :: forall x.
DeletePlatformVersionResponse
-> Rep DeletePlatformVersionResponse x
Prelude.Generic)

-- |
-- Create a value of 'DeletePlatformVersionResponse' 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:
--
-- 'platformSummary', 'deletePlatformVersionResponse_platformSummary' - Detailed information about the version of the custom platform.
--
-- 'httpStatus', 'deletePlatformVersionResponse_httpStatus' - The response's http status code.
newDeletePlatformVersionResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  DeletePlatformVersionResponse
newDeletePlatformVersionResponse :: Int -> DeletePlatformVersionResponse
newDeletePlatformVersionResponse Int
pHttpStatus_ =
  DeletePlatformVersionResponse'
    { $sel:platformSummary:DeletePlatformVersionResponse' :: Maybe PlatformSummary
platformSummary =
        forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:DeletePlatformVersionResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | Detailed information about the version of the custom platform.
deletePlatformVersionResponse_platformSummary :: Lens.Lens' DeletePlatformVersionResponse (Prelude.Maybe PlatformSummary)
deletePlatformVersionResponse_platformSummary :: Lens' DeletePlatformVersionResponse (Maybe PlatformSummary)
deletePlatformVersionResponse_platformSummary = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DeletePlatformVersionResponse' {Maybe PlatformSummary
platformSummary :: Maybe PlatformSummary
$sel:platformSummary:DeletePlatformVersionResponse' :: DeletePlatformVersionResponse -> Maybe PlatformSummary
platformSummary} -> Maybe PlatformSummary
platformSummary) (\s :: DeletePlatformVersionResponse
s@DeletePlatformVersionResponse' {} Maybe PlatformSummary
a -> DeletePlatformVersionResponse
s {$sel:platformSummary:DeletePlatformVersionResponse' :: Maybe PlatformSummary
platformSummary = Maybe PlatformSummary
a} :: DeletePlatformVersionResponse)

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

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