{-# 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.Batch.DeleteComputeEnvironment
-- 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 an Batch compute environment.
--
-- Before you can delete a compute environment, you must set its state to
-- @DISABLED@ with the UpdateComputeEnvironment API operation and
-- disassociate it from any job queues with the UpdateJobQueue API
-- operation. Compute environments that use Fargate resources must
-- terminate all active jobs on that compute environment before deleting
-- the compute environment. If this isn\'t done, the compute environment
-- enters an invalid state.
module Amazonka.Batch.DeleteComputeEnvironment
  ( -- * Creating a Request
    DeleteComputeEnvironment (..),
    newDeleteComputeEnvironment,

    -- * Request Lenses
    deleteComputeEnvironment_computeEnvironment,

    -- * Destructuring the Response
    DeleteComputeEnvironmentResponse (..),
    newDeleteComputeEnvironmentResponse,

    -- * Response Lenses
    deleteComputeEnvironmentResponse_httpStatus,
  )
where

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

-- | Contains the parameters for @DeleteComputeEnvironment@.
--
-- /See:/ 'newDeleteComputeEnvironment' smart constructor.
data DeleteComputeEnvironment = DeleteComputeEnvironment'
  { -- | The name or Amazon Resource Name (ARN) of the compute environment to
    -- delete.
    DeleteComputeEnvironment -> Text
computeEnvironment :: Prelude.Text
  }
  deriving (DeleteComputeEnvironment -> DeleteComputeEnvironment -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DeleteComputeEnvironment -> DeleteComputeEnvironment -> Bool
$c/= :: DeleteComputeEnvironment -> DeleteComputeEnvironment -> Bool
== :: DeleteComputeEnvironment -> DeleteComputeEnvironment -> Bool
$c== :: DeleteComputeEnvironment -> DeleteComputeEnvironment -> Bool
Prelude.Eq, ReadPrec [DeleteComputeEnvironment]
ReadPrec DeleteComputeEnvironment
Int -> ReadS DeleteComputeEnvironment
ReadS [DeleteComputeEnvironment]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DeleteComputeEnvironment]
$creadListPrec :: ReadPrec [DeleteComputeEnvironment]
readPrec :: ReadPrec DeleteComputeEnvironment
$creadPrec :: ReadPrec DeleteComputeEnvironment
readList :: ReadS [DeleteComputeEnvironment]
$creadList :: ReadS [DeleteComputeEnvironment]
readsPrec :: Int -> ReadS DeleteComputeEnvironment
$creadsPrec :: Int -> ReadS DeleteComputeEnvironment
Prelude.Read, Int -> DeleteComputeEnvironment -> ShowS
[DeleteComputeEnvironment] -> ShowS
DeleteComputeEnvironment -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DeleteComputeEnvironment] -> ShowS
$cshowList :: [DeleteComputeEnvironment] -> ShowS
show :: DeleteComputeEnvironment -> String
$cshow :: DeleteComputeEnvironment -> String
showsPrec :: Int -> DeleteComputeEnvironment -> ShowS
$cshowsPrec :: Int -> DeleteComputeEnvironment -> ShowS
Prelude.Show, forall x.
Rep DeleteComputeEnvironment x -> DeleteComputeEnvironment
forall x.
DeleteComputeEnvironment -> Rep DeleteComputeEnvironment x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep DeleteComputeEnvironment x -> DeleteComputeEnvironment
$cfrom :: forall x.
DeleteComputeEnvironment -> Rep DeleteComputeEnvironment x
Prelude.Generic)

-- |
-- Create a value of 'DeleteComputeEnvironment' 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:
--
-- 'computeEnvironment', 'deleteComputeEnvironment_computeEnvironment' - The name or Amazon Resource Name (ARN) of the compute environment to
-- delete.
newDeleteComputeEnvironment ::
  -- | 'computeEnvironment'
  Prelude.Text ->
  DeleteComputeEnvironment
newDeleteComputeEnvironment :: Text -> DeleteComputeEnvironment
newDeleteComputeEnvironment Text
pComputeEnvironment_ =
  DeleteComputeEnvironment'
    { $sel:computeEnvironment:DeleteComputeEnvironment' :: Text
computeEnvironment =
        Text
pComputeEnvironment_
    }

-- | The name or Amazon Resource Name (ARN) of the compute environment to
-- delete.
deleteComputeEnvironment_computeEnvironment :: Lens.Lens' DeleteComputeEnvironment Prelude.Text
deleteComputeEnvironment_computeEnvironment :: Lens' DeleteComputeEnvironment Text
deleteComputeEnvironment_computeEnvironment = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DeleteComputeEnvironment' {Text
computeEnvironment :: Text
$sel:computeEnvironment:DeleteComputeEnvironment' :: DeleteComputeEnvironment -> Text
computeEnvironment} -> Text
computeEnvironment) (\s :: DeleteComputeEnvironment
s@DeleteComputeEnvironment' {} Text
a -> DeleteComputeEnvironment
s {$sel:computeEnvironment:DeleteComputeEnvironment' :: Text
computeEnvironment = Text
a} :: DeleteComputeEnvironment)

instance Core.AWSRequest DeleteComputeEnvironment where
  type
    AWSResponse DeleteComputeEnvironment =
      DeleteComputeEnvironmentResponse
  request :: (Service -> Service)
-> DeleteComputeEnvironment -> Request DeleteComputeEnvironment
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 DeleteComputeEnvironment
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse DeleteComputeEnvironment)))
response =
    forall (m :: * -> *) a.
MonadResource m =>
(Int -> ResponseHeaders -> () -> Either String (AWSResponse a))
-> (ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy a
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse a)))
Response.receiveEmpty
      ( \Int
s ResponseHeaders
h ()
x ->
          Int -> DeleteComputeEnvironmentResponse
DeleteComputeEnvironmentResponse'
            forall (f :: * -> *) a b. Functor 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 DeleteComputeEnvironment where
  hashWithSalt :: Int -> DeleteComputeEnvironment -> Int
hashWithSalt Int
_salt DeleteComputeEnvironment' {Text
computeEnvironment :: Text
$sel:computeEnvironment:DeleteComputeEnvironment' :: DeleteComputeEnvironment -> Text
..} =
    Int
_salt forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
computeEnvironment

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

instance Data.ToHeaders DeleteComputeEnvironment where
  toHeaders :: DeleteComputeEnvironment -> 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.ToJSON DeleteComputeEnvironment where
  toJSON :: DeleteComputeEnvironment -> Value
toJSON DeleteComputeEnvironment' {Text
computeEnvironment :: Text
$sel:computeEnvironment:DeleteComputeEnvironment' :: DeleteComputeEnvironment -> Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ forall a. a -> Maybe a
Prelude.Just
              (Key
"computeEnvironment" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
computeEnvironment)
          ]
      )

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

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

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

-- |
-- Create a value of 'DeleteComputeEnvironmentResponse' 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:
--
-- 'httpStatus', 'deleteComputeEnvironmentResponse_httpStatus' - The response's http status code.
newDeleteComputeEnvironmentResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  DeleteComputeEnvironmentResponse
newDeleteComputeEnvironmentResponse :: Int -> DeleteComputeEnvironmentResponse
newDeleteComputeEnvironmentResponse Int
pHttpStatus_ =
  DeleteComputeEnvironmentResponse'
    { $sel:httpStatus:DeleteComputeEnvironmentResponse' :: Int
httpStatus =
        Int
pHttpStatus_
    }

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

instance
  Prelude.NFData
    DeleteComputeEnvironmentResponse
  where
  rnf :: DeleteComputeEnvironmentResponse -> ()
rnf DeleteComputeEnvironmentResponse' {Int
httpStatus :: Int
$sel:httpStatus:DeleteComputeEnvironmentResponse' :: DeleteComputeEnvironmentResponse -> Int
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus