{-# 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.IoT.DeleteJob
-- 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 a job and its related job executions.
--
-- Deleting a job may take time, depending on the number of job executions
-- created for the job and various other factors. While the job is being
-- deleted, the status of the job will be shown as
-- \"DELETION_IN_PROGRESS\". Attempting to delete or cancel a job whose
-- status is already \"DELETION_IN_PROGRESS\" will result in an error.
--
-- Only 10 jobs may have status \"DELETION_IN_PROGRESS\" at the same time,
-- or a LimitExceededException will occur.
--
-- Requires permission to access the
-- <https://docs.aws.amazon.com/service-authorization/latest/reference/list_awsiot.html#awsiot-actions-as-permissions DeleteJob>
-- action.
module Amazonka.IoT.DeleteJob
  ( -- * Creating a Request
    DeleteJob (..),
    newDeleteJob,

    -- * Request Lenses
    deleteJob_force,
    deleteJob_namespaceId,
    deleteJob_jobId,

    -- * Destructuring the Response
    DeleteJobResponse (..),
    newDeleteJobResponse,
  )
where

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

-- | /See:/ 'newDeleteJob' smart constructor.
data DeleteJob = DeleteJob'
  { -- | (Optional) When true, you can delete a job which is \"IN_PROGRESS\".
    -- Otherwise, you can only delete a job which is in a terminal state
    -- (\"COMPLETED\" or \"CANCELED\") or an exception will occur. The default
    -- is false.
    --
    -- Deleting a job which is \"IN_PROGRESS\", will cause a device which is
    -- executing the job to be unable to access job information or update the
    -- job execution status. Use caution and ensure that each device executing
    -- a job which is deleted is able to recover to a valid state.
    DeleteJob -> Maybe Bool
force :: Prelude.Maybe Prelude.Bool,
    -- | The namespace used to indicate that a job is a customer-managed job.
    --
    -- When you specify a value for this parameter, Amazon Web Services IoT
    -- Core sends jobs notifications to MQTT topics that contain the value in
    -- the following format.
    --
    -- @$aws\/things\/@/@THING_NAME@/@\/jobs\/@/@JOB_ID@/@\/notify-namespace-@/@NAMESPACE_ID@/@\/@
    --
    -- The @namespaceId@ feature is in public preview.
    DeleteJob -> Maybe Text
namespaceId :: Prelude.Maybe Prelude.Text,
    -- | The ID of the job to be deleted.
    --
    -- After a job deletion is completed, you may reuse this jobId when you
    -- create a new job. However, this is not recommended, and you must ensure
    -- that your devices are not using the jobId to refer to the deleted job.
    DeleteJob -> Text
jobId :: Prelude.Text
  }
  deriving (DeleteJob -> DeleteJob -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DeleteJob -> DeleteJob -> Bool
$c/= :: DeleteJob -> DeleteJob -> Bool
== :: DeleteJob -> DeleteJob -> Bool
$c== :: DeleteJob -> DeleteJob -> Bool
Prelude.Eq, ReadPrec [DeleteJob]
ReadPrec DeleteJob
Int -> ReadS DeleteJob
ReadS [DeleteJob]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DeleteJob]
$creadListPrec :: ReadPrec [DeleteJob]
readPrec :: ReadPrec DeleteJob
$creadPrec :: ReadPrec DeleteJob
readList :: ReadS [DeleteJob]
$creadList :: ReadS [DeleteJob]
readsPrec :: Int -> ReadS DeleteJob
$creadsPrec :: Int -> ReadS DeleteJob
Prelude.Read, Int -> DeleteJob -> ShowS
[DeleteJob] -> ShowS
DeleteJob -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DeleteJob] -> ShowS
$cshowList :: [DeleteJob] -> ShowS
show :: DeleteJob -> String
$cshow :: DeleteJob -> String
showsPrec :: Int -> DeleteJob -> ShowS
$cshowsPrec :: Int -> DeleteJob -> ShowS
Prelude.Show, forall x. Rep DeleteJob x -> DeleteJob
forall x. DeleteJob -> Rep DeleteJob x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep DeleteJob x -> DeleteJob
$cfrom :: forall x. DeleteJob -> Rep DeleteJob x
Prelude.Generic)

-- |
-- Create a value of 'DeleteJob' 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:
--
-- 'force', 'deleteJob_force' - (Optional) When true, you can delete a job which is \"IN_PROGRESS\".
-- Otherwise, you can only delete a job which is in a terminal state
-- (\"COMPLETED\" or \"CANCELED\") or an exception will occur. The default
-- is false.
--
-- Deleting a job which is \"IN_PROGRESS\", will cause a device which is
-- executing the job to be unable to access job information or update the
-- job execution status. Use caution and ensure that each device executing
-- a job which is deleted is able to recover to a valid state.
--
-- 'namespaceId', 'deleteJob_namespaceId' - The namespace used to indicate that a job is a customer-managed job.
--
-- When you specify a value for this parameter, Amazon Web Services IoT
-- Core sends jobs notifications to MQTT topics that contain the value in
-- the following format.
--
-- @$aws\/things\/@/@THING_NAME@/@\/jobs\/@/@JOB_ID@/@\/notify-namespace-@/@NAMESPACE_ID@/@\/@
--
-- The @namespaceId@ feature is in public preview.
--
-- 'jobId', 'deleteJob_jobId' - The ID of the job to be deleted.
--
-- After a job deletion is completed, you may reuse this jobId when you
-- create a new job. However, this is not recommended, and you must ensure
-- that your devices are not using the jobId to refer to the deleted job.
newDeleteJob ::
  -- | 'jobId'
  Prelude.Text ->
  DeleteJob
newDeleteJob :: Text -> DeleteJob
newDeleteJob Text
pJobId_ =
  DeleteJob'
    { $sel:force:DeleteJob' :: Maybe Bool
force = forall a. Maybe a
Prelude.Nothing,
      $sel:namespaceId:DeleteJob' :: Maybe Text
namespaceId = forall a. Maybe a
Prelude.Nothing,
      $sel:jobId:DeleteJob' :: Text
jobId = Text
pJobId_
    }

-- | (Optional) When true, you can delete a job which is \"IN_PROGRESS\".
-- Otherwise, you can only delete a job which is in a terminal state
-- (\"COMPLETED\" or \"CANCELED\") or an exception will occur. The default
-- is false.
--
-- Deleting a job which is \"IN_PROGRESS\", will cause a device which is
-- executing the job to be unable to access job information or update the
-- job execution status. Use caution and ensure that each device executing
-- a job which is deleted is able to recover to a valid state.
deleteJob_force :: Lens.Lens' DeleteJob (Prelude.Maybe Prelude.Bool)
deleteJob_force :: Lens' DeleteJob (Maybe Bool)
deleteJob_force = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DeleteJob' {Maybe Bool
force :: Maybe Bool
$sel:force:DeleteJob' :: DeleteJob -> Maybe Bool
force} -> Maybe Bool
force) (\s :: DeleteJob
s@DeleteJob' {} Maybe Bool
a -> DeleteJob
s {$sel:force:DeleteJob' :: Maybe Bool
force = Maybe Bool
a} :: DeleteJob)

-- | The namespace used to indicate that a job is a customer-managed job.
--
-- When you specify a value for this parameter, Amazon Web Services IoT
-- Core sends jobs notifications to MQTT topics that contain the value in
-- the following format.
--
-- @$aws\/things\/@/@THING_NAME@/@\/jobs\/@/@JOB_ID@/@\/notify-namespace-@/@NAMESPACE_ID@/@\/@
--
-- The @namespaceId@ feature is in public preview.
deleteJob_namespaceId :: Lens.Lens' DeleteJob (Prelude.Maybe Prelude.Text)
deleteJob_namespaceId :: Lens' DeleteJob (Maybe Text)
deleteJob_namespaceId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DeleteJob' {Maybe Text
namespaceId :: Maybe Text
$sel:namespaceId:DeleteJob' :: DeleteJob -> Maybe Text
namespaceId} -> Maybe Text
namespaceId) (\s :: DeleteJob
s@DeleteJob' {} Maybe Text
a -> DeleteJob
s {$sel:namespaceId:DeleteJob' :: Maybe Text
namespaceId = Maybe Text
a} :: DeleteJob)

-- | The ID of the job to be deleted.
--
-- After a job deletion is completed, you may reuse this jobId when you
-- create a new job. However, this is not recommended, and you must ensure
-- that your devices are not using the jobId to refer to the deleted job.
deleteJob_jobId :: Lens.Lens' DeleteJob Prelude.Text
deleteJob_jobId :: Lens' DeleteJob Text
deleteJob_jobId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DeleteJob' {Text
jobId :: Text
$sel:jobId:DeleteJob' :: DeleteJob -> Text
jobId} -> Text
jobId) (\s :: DeleteJob
s@DeleteJob' {} Text
a -> DeleteJob
s {$sel:jobId:DeleteJob' :: Text
jobId = Text
a} :: DeleteJob)

instance Core.AWSRequest DeleteJob where
  type AWSResponse DeleteJob = DeleteJobResponse
  request :: (Service -> Service) -> DeleteJob -> Request DeleteJob
request Service -> Service
overrides =
    forall a. ToRequest a => Service -> a -> Request a
Request.delete (Service -> Service
overrides Service
defaultService)
  response :: forall (m :: * -> *).
MonadResource m =>
(ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy DeleteJob
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse DeleteJob)))
response = forall (m :: * -> *) a.
MonadResource m =>
AWSResponse a
-> (ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy a
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse a)))
Response.receiveNull DeleteJobResponse
DeleteJobResponse'

instance Prelude.Hashable DeleteJob where
  hashWithSalt :: Int -> DeleteJob -> Int
hashWithSalt Int
_salt DeleteJob' {Maybe Bool
Maybe Text
Text
jobId :: Text
namespaceId :: Maybe Text
force :: Maybe Bool
$sel:jobId:DeleteJob' :: DeleteJob -> Text
$sel:namespaceId:DeleteJob' :: DeleteJob -> Maybe Text
$sel:force:DeleteJob' :: DeleteJob -> Maybe Bool
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Bool
force
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
namespaceId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
jobId

instance Prelude.NFData DeleteJob where
  rnf :: DeleteJob -> ()
rnf DeleteJob' {Maybe Bool
Maybe Text
Text
jobId :: Text
namespaceId :: Maybe Text
force :: Maybe Bool
$sel:jobId:DeleteJob' :: DeleteJob -> Text
$sel:namespaceId:DeleteJob' :: DeleteJob -> Maybe Text
$sel:force:DeleteJob' :: DeleteJob -> Maybe Bool
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Bool
force
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
namespaceId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
jobId

instance Data.ToHeaders DeleteJob where
  toHeaders :: DeleteJob -> [Header]
toHeaders = forall a b. a -> b -> a
Prelude.const forall a. Monoid a => a
Prelude.mempty

instance Data.ToPath DeleteJob where
  toPath :: DeleteJob -> ByteString
toPath DeleteJob' {Maybe Bool
Maybe Text
Text
jobId :: Text
namespaceId :: Maybe Text
force :: Maybe Bool
$sel:jobId:DeleteJob' :: DeleteJob -> Text
$sel:namespaceId:DeleteJob' :: DeleteJob -> Maybe Text
$sel:force:DeleteJob' :: DeleteJob -> Maybe Bool
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat [ByteString
"/jobs/", forall a. ToByteString a => a -> ByteString
Data.toBS Text
jobId]

instance Data.ToQuery DeleteJob where
  toQuery :: DeleteJob -> QueryString
toQuery DeleteJob' {Maybe Bool
Maybe Text
Text
jobId :: Text
namespaceId :: Maybe Text
force :: Maybe Bool
$sel:jobId:DeleteJob' :: DeleteJob -> Text
$sel:namespaceId:DeleteJob' :: DeleteJob -> Maybe Text
$sel:force:DeleteJob' :: DeleteJob -> Maybe Bool
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"force" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Bool
force,
        ByteString
"namespaceId" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Text
namespaceId
      ]

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

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

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