{-# 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.ECS.DeregisterTaskDefinition
-- 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 the specified task definition by family and revision. Upon
-- deregistration, the task definition is marked as @INACTIVE@. Existing
-- tasks and services that reference an @INACTIVE@ task definition continue
-- to run without disruption. Existing services that reference an
-- @INACTIVE@ task definition can still scale up or down by modifying the
-- service\'s desired count.
--
-- You can\'t use an @INACTIVE@ task definition to run new tasks or create
-- new services, and you can\'t update an existing service to reference an
-- @INACTIVE@ task definition. However, there may be up to a 10-minute
-- window following deregistration where these restrictions have not yet
-- taken effect.
--
-- At this time, @INACTIVE@ task definitions remain discoverable in your
-- account indefinitely. However, this behavior is subject to change in the
-- future. We don\'t recommend that you rely on @INACTIVE@ task definitions
-- persisting beyond the lifecycle of any associated tasks and services.
module Amazonka.ECS.DeregisterTaskDefinition
  ( -- * Creating a Request
    DeregisterTaskDefinition (..),
    newDeregisterTaskDefinition,

    -- * Request Lenses
    deregisterTaskDefinition_taskDefinition,

    -- * Destructuring the Response
    DeregisterTaskDefinitionResponse (..),
    newDeregisterTaskDefinitionResponse,

    -- * Response Lenses
    deregisterTaskDefinitionResponse_taskDefinition,
    deregisterTaskDefinitionResponse_httpStatus,
  )
where

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

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

-- |
-- Create a value of 'DeregisterTaskDefinition' 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:
--
-- 'taskDefinition', 'deregisterTaskDefinition_taskDefinition' - The @family@ and @revision@ (@family:revision@) or full Amazon Resource
-- Name (ARN) of the task definition to deregister. You must specify a
-- @revision@.
newDeregisterTaskDefinition ::
  -- | 'taskDefinition'
  Prelude.Text ->
  DeregisterTaskDefinition
newDeregisterTaskDefinition :: Text -> DeregisterTaskDefinition
newDeregisterTaskDefinition Text
pTaskDefinition_ =
  DeregisterTaskDefinition'
    { $sel:taskDefinition:DeregisterTaskDefinition' :: Text
taskDefinition =
        Text
pTaskDefinition_
    }

-- | The @family@ and @revision@ (@family:revision@) or full Amazon Resource
-- Name (ARN) of the task definition to deregister. You must specify a
-- @revision@.
deregisterTaskDefinition_taskDefinition :: Lens.Lens' DeregisterTaskDefinition Prelude.Text
deregisterTaskDefinition_taskDefinition :: Lens' DeregisterTaskDefinition Text
deregisterTaskDefinition_taskDefinition = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DeregisterTaskDefinition' {Text
taskDefinition :: Text
$sel:taskDefinition:DeregisterTaskDefinition' :: DeregisterTaskDefinition -> Text
taskDefinition} -> Text
taskDefinition) (\s :: DeregisterTaskDefinition
s@DeregisterTaskDefinition' {} Text
a -> DeregisterTaskDefinition
s {$sel:taskDefinition:DeregisterTaskDefinition' :: Text
taskDefinition = Text
a} :: DeregisterTaskDefinition)

instance Core.AWSRequest DeregisterTaskDefinition where
  type
    AWSResponse DeregisterTaskDefinition =
      DeregisterTaskDefinitionResponse
  request :: (Service -> Service)
-> DeregisterTaskDefinition -> Request DeregisterTaskDefinition
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 DeregisterTaskDefinition
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse DeregisterTaskDefinition)))
response =
    forall (m :: * -> *) a.
MonadResource m =>
(Int -> ResponseHeaders -> Object -> Either String (AWSResponse a))
-> (ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy a
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse a)))
Response.receiveJSON
      ( \Int
s ResponseHeaders
h Object
x ->
          Maybe TaskDefinition -> Int -> DeregisterTaskDefinitionResponse
DeregisterTaskDefinitionResponse'
            forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"taskDefinition")
            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 DeregisterTaskDefinition where
  hashWithSalt :: Int -> DeregisterTaskDefinition -> Int
hashWithSalt Int
_salt DeregisterTaskDefinition' {Text
taskDefinition :: Text
$sel:taskDefinition:DeregisterTaskDefinition' :: DeregisterTaskDefinition -> Text
..} =
    Int
_salt forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
taskDefinition

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

instance Data.ToHeaders DeregisterTaskDefinition where
  toHeaders :: DeregisterTaskDefinition -> ResponseHeaders
toHeaders =
    forall a b. a -> b -> a
Prelude.const
      ( forall a. Monoid a => [a] -> a
Prelude.mconcat
          [ HeaderName
"X-Amz-Target"
              forall a. ToHeader a => HeaderName -> a -> ResponseHeaders
Data.=# ( ByteString
"AmazonEC2ContainerServiceV20141113.DeregisterTaskDefinition" ::
                          Prelude.ByteString
                      ),
            HeaderName
"Content-Type"
              forall a. ToHeader a => HeaderName -> a -> ResponseHeaders
Data.=# ( ByteString
"application/x-amz-json-1.1" ::
                          Prelude.ByteString
                      )
          ]
      )

instance Data.ToJSON DeregisterTaskDefinition where
  toJSON :: DeregisterTaskDefinition -> Value
toJSON DeregisterTaskDefinition' {Text
taskDefinition :: Text
$sel:taskDefinition:DeregisterTaskDefinition' :: DeregisterTaskDefinition -> Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ forall a. a -> Maybe a
Prelude.Just
              (Key
"taskDefinition" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
taskDefinition)
          ]
      )

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

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

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

-- |
-- Create a value of 'DeregisterTaskDefinitionResponse' 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:
--
-- 'taskDefinition', 'deregisterTaskDefinitionResponse_taskDefinition' - The full description of the deregistered task.
--
-- 'httpStatus', 'deregisterTaskDefinitionResponse_httpStatus' - The response's http status code.
newDeregisterTaskDefinitionResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  DeregisterTaskDefinitionResponse
newDeregisterTaskDefinitionResponse :: Int -> DeregisterTaskDefinitionResponse
newDeregisterTaskDefinitionResponse Int
pHttpStatus_ =
  DeregisterTaskDefinitionResponse'
    { $sel:taskDefinition:DeregisterTaskDefinitionResponse' :: Maybe TaskDefinition
taskDefinition =
        forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:DeregisterTaskDefinitionResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | The full description of the deregistered task.
deregisterTaskDefinitionResponse_taskDefinition :: Lens.Lens' DeregisterTaskDefinitionResponse (Prelude.Maybe TaskDefinition)
deregisterTaskDefinitionResponse_taskDefinition :: Lens' DeregisterTaskDefinitionResponse (Maybe TaskDefinition)
deregisterTaskDefinitionResponse_taskDefinition = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DeregisterTaskDefinitionResponse' {Maybe TaskDefinition
taskDefinition :: Maybe TaskDefinition
$sel:taskDefinition:DeregisterTaskDefinitionResponse' :: DeregisterTaskDefinitionResponse -> Maybe TaskDefinition
taskDefinition} -> Maybe TaskDefinition
taskDefinition) (\s :: DeregisterTaskDefinitionResponse
s@DeregisterTaskDefinitionResponse' {} Maybe TaskDefinition
a -> DeregisterTaskDefinitionResponse
s {$sel:taskDefinition:DeregisterTaskDefinitionResponse' :: Maybe TaskDefinition
taskDefinition = Maybe TaskDefinition
a} :: DeregisterTaskDefinitionResponse)

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

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