{-# 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.DeregisterJobDefinition
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Deregisters an Batch job definition. Job definitions are permanently
-- deleted after 180 days.
module Amazonka.Batch.DeregisterJobDefinition
  ( -- * Creating a Request
    DeregisterJobDefinition (..),
    newDeregisterJobDefinition,

    -- * Request Lenses
    deregisterJobDefinition_jobDefinition,

    -- * Destructuring the Response
    DeregisterJobDefinitionResponse (..),
    newDeregisterJobDefinitionResponse,

    -- * Response Lenses
    deregisterJobDefinitionResponse_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

-- | /See:/ 'newDeregisterJobDefinition' smart constructor.
data DeregisterJobDefinition = DeregisterJobDefinition'
  { -- | The name and revision (@name:revision@) or full Amazon Resource Name
    -- (ARN) of the job definition to deregister.
    DeregisterJobDefinition -> Text
jobDefinition :: Prelude.Text
  }
  deriving (DeregisterJobDefinition -> DeregisterJobDefinition -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DeregisterJobDefinition -> DeregisterJobDefinition -> Bool
$c/= :: DeregisterJobDefinition -> DeregisterJobDefinition -> Bool
== :: DeregisterJobDefinition -> DeregisterJobDefinition -> Bool
$c== :: DeregisterJobDefinition -> DeregisterJobDefinition -> Bool
Prelude.Eq, ReadPrec [DeregisterJobDefinition]
ReadPrec DeregisterJobDefinition
Int -> ReadS DeregisterJobDefinition
ReadS [DeregisterJobDefinition]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DeregisterJobDefinition]
$creadListPrec :: ReadPrec [DeregisterJobDefinition]
readPrec :: ReadPrec DeregisterJobDefinition
$creadPrec :: ReadPrec DeregisterJobDefinition
readList :: ReadS [DeregisterJobDefinition]
$creadList :: ReadS [DeregisterJobDefinition]
readsPrec :: Int -> ReadS DeregisterJobDefinition
$creadsPrec :: Int -> ReadS DeregisterJobDefinition
Prelude.Read, Int -> DeregisterJobDefinition -> ShowS
[DeregisterJobDefinition] -> ShowS
DeregisterJobDefinition -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DeregisterJobDefinition] -> ShowS
$cshowList :: [DeregisterJobDefinition] -> ShowS
show :: DeregisterJobDefinition -> String
$cshow :: DeregisterJobDefinition -> String
showsPrec :: Int -> DeregisterJobDefinition -> ShowS
$cshowsPrec :: Int -> DeregisterJobDefinition -> ShowS
Prelude.Show, forall x. Rep DeregisterJobDefinition x -> DeregisterJobDefinition
forall x. DeregisterJobDefinition -> Rep DeregisterJobDefinition x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep DeregisterJobDefinition x -> DeregisterJobDefinition
$cfrom :: forall x. DeregisterJobDefinition -> Rep DeregisterJobDefinition x
Prelude.Generic)

-- |
-- Create a value of 'DeregisterJobDefinition' 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:
--
-- 'jobDefinition', 'deregisterJobDefinition_jobDefinition' - The name and revision (@name:revision@) or full Amazon Resource Name
-- (ARN) of the job definition to deregister.
newDeregisterJobDefinition ::
  -- | 'jobDefinition'
  Prelude.Text ->
  DeregisterJobDefinition
newDeregisterJobDefinition :: Text -> DeregisterJobDefinition
newDeregisterJobDefinition Text
pJobDefinition_ =
  DeregisterJobDefinition'
    { $sel:jobDefinition:DeregisterJobDefinition' :: Text
jobDefinition =
        Text
pJobDefinition_
    }

-- | The name and revision (@name:revision@) or full Amazon Resource Name
-- (ARN) of the job definition to deregister.
deregisterJobDefinition_jobDefinition :: Lens.Lens' DeregisterJobDefinition Prelude.Text
deregisterJobDefinition_jobDefinition :: Lens' DeregisterJobDefinition Text
deregisterJobDefinition_jobDefinition = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DeregisterJobDefinition' {Text
jobDefinition :: Text
$sel:jobDefinition:DeregisterJobDefinition' :: DeregisterJobDefinition -> Text
jobDefinition} -> Text
jobDefinition) (\s :: DeregisterJobDefinition
s@DeregisterJobDefinition' {} Text
a -> DeregisterJobDefinition
s {$sel:jobDefinition:DeregisterJobDefinition' :: Text
jobDefinition = Text
a} :: DeregisterJobDefinition)

instance Core.AWSRequest DeregisterJobDefinition where
  type
    AWSResponse DeregisterJobDefinition =
      DeregisterJobDefinitionResponse
  request :: (Service -> Service)
-> DeregisterJobDefinition -> Request DeregisterJobDefinition
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 DeregisterJobDefinition
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse DeregisterJobDefinition)))
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 -> DeregisterJobDefinitionResponse
DeregisterJobDefinitionResponse'
            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 DeregisterJobDefinition where
  hashWithSalt :: Int -> DeregisterJobDefinition -> Int
hashWithSalt Int
_salt DeregisterJobDefinition' {Text
jobDefinition :: Text
$sel:jobDefinition:DeregisterJobDefinition' :: DeregisterJobDefinition -> Text
..} =
    Int
_salt forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
jobDefinition

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

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

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

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

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

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

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

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