{-# 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.DeleteJobExecution
-- 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 execution.
--
-- Requires permission to access the
-- <https://docs.aws.amazon.com/service-authorization/latest/reference/list_awsiot.html#awsiot-actions-as-permissions DeleteJobExecution>
-- action.
module Amazonka.IoT.DeleteJobExecution
  ( -- * Creating a Request
    DeleteJobExecution (..),
    newDeleteJobExecution,

    -- * Request Lenses
    deleteJobExecution_force,
    deleteJobExecution_namespaceId,
    deleteJobExecution_jobId,
    deleteJobExecution_thingName,
    deleteJobExecution_executionNumber,

    -- * Destructuring the Response
    DeleteJobExecutionResponse (..),
    newDeleteJobExecutionResponse,
  )
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:/ 'newDeleteJobExecution' smart constructor.
data DeleteJobExecution = DeleteJobExecution'
  { -- | (Optional) When true, you can delete a job execution which is
    -- \"IN_PROGRESS\". Otherwise, you can only delete a job execution which is
    -- in a terminal state (\"SUCCEEDED\", \"FAILED\", \"REJECTED\",
    -- \"REMOVED\" or \"CANCELED\") or an exception will occur. The default is
    -- false.
    --
    -- Deleting a job execution which is \"IN_PROGRESS\", will cause the device
    -- to be unable to access job information or update the job execution
    -- status. Use caution and ensure that the device is able to recover to a
    -- valid state.
    DeleteJobExecution -> 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.
    DeleteJobExecution -> Maybe Text
namespaceId :: Prelude.Maybe Prelude.Text,
    -- | The ID of the job whose execution on a particular device will be
    -- deleted.
    DeleteJobExecution -> Text
jobId :: Prelude.Text,
    -- | The name of the thing whose job execution will be deleted.
    DeleteJobExecution -> Text
thingName :: Prelude.Text,
    -- | The ID of the job execution to be deleted. The @executionNumber@ refers
    -- to the execution of a particular job on a particular device.
    --
    -- Note that once a job execution is deleted, the @executionNumber@ may be
    -- reused by IoT, so be sure you get and use the correct value here.
    DeleteJobExecution -> Integer
executionNumber :: Prelude.Integer
  }
  deriving (DeleteJobExecution -> DeleteJobExecution -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DeleteJobExecution -> DeleteJobExecution -> Bool
$c/= :: DeleteJobExecution -> DeleteJobExecution -> Bool
== :: DeleteJobExecution -> DeleteJobExecution -> Bool
$c== :: DeleteJobExecution -> DeleteJobExecution -> Bool
Prelude.Eq, ReadPrec [DeleteJobExecution]
ReadPrec DeleteJobExecution
Int -> ReadS DeleteJobExecution
ReadS [DeleteJobExecution]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DeleteJobExecution]
$creadListPrec :: ReadPrec [DeleteJobExecution]
readPrec :: ReadPrec DeleteJobExecution
$creadPrec :: ReadPrec DeleteJobExecution
readList :: ReadS [DeleteJobExecution]
$creadList :: ReadS [DeleteJobExecution]
readsPrec :: Int -> ReadS DeleteJobExecution
$creadsPrec :: Int -> ReadS DeleteJobExecution
Prelude.Read, Int -> DeleteJobExecution -> ShowS
[DeleteJobExecution] -> ShowS
DeleteJobExecution -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DeleteJobExecution] -> ShowS
$cshowList :: [DeleteJobExecution] -> ShowS
show :: DeleteJobExecution -> String
$cshow :: DeleteJobExecution -> String
showsPrec :: Int -> DeleteJobExecution -> ShowS
$cshowsPrec :: Int -> DeleteJobExecution -> ShowS
Prelude.Show, forall x. Rep DeleteJobExecution x -> DeleteJobExecution
forall x. DeleteJobExecution -> Rep DeleteJobExecution x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep DeleteJobExecution x -> DeleteJobExecution
$cfrom :: forall x. DeleteJobExecution -> Rep DeleteJobExecution x
Prelude.Generic)

-- |
-- Create a value of 'DeleteJobExecution' 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', 'deleteJobExecution_force' - (Optional) When true, you can delete a job execution which is
-- \"IN_PROGRESS\". Otherwise, you can only delete a job execution which is
-- in a terminal state (\"SUCCEEDED\", \"FAILED\", \"REJECTED\",
-- \"REMOVED\" or \"CANCELED\") or an exception will occur. The default is
-- false.
--
-- Deleting a job execution which is \"IN_PROGRESS\", will cause the device
-- to be unable to access job information or update the job execution
-- status. Use caution and ensure that the device is able to recover to a
-- valid state.
--
-- 'namespaceId', 'deleteJobExecution_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', 'deleteJobExecution_jobId' - The ID of the job whose execution on a particular device will be
-- deleted.
--
-- 'thingName', 'deleteJobExecution_thingName' - The name of the thing whose job execution will be deleted.
--
-- 'executionNumber', 'deleteJobExecution_executionNumber' - The ID of the job execution to be deleted. The @executionNumber@ refers
-- to the execution of a particular job on a particular device.
--
-- Note that once a job execution is deleted, the @executionNumber@ may be
-- reused by IoT, so be sure you get and use the correct value here.
newDeleteJobExecution ::
  -- | 'jobId'
  Prelude.Text ->
  -- | 'thingName'
  Prelude.Text ->
  -- | 'executionNumber'
  Prelude.Integer ->
  DeleteJobExecution
newDeleteJobExecution :: Text -> Text -> Integer -> DeleteJobExecution
newDeleteJobExecution
  Text
pJobId_
  Text
pThingName_
  Integer
pExecutionNumber_ =
    DeleteJobExecution'
      { $sel:force:DeleteJobExecution' :: Maybe Bool
force = forall a. Maybe a
Prelude.Nothing,
        $sel:namespaceId:DeleteJobExecution' :: Maybe Text
namespaceId = forall a. Maybe a
Prelude.Nothing,
        $sel:jobId:DeleteJobExecution' :: Text
jobId = Text
pJobId_,
        $sel:thingName:DeleteJobExecution' :: Text
thingName = Text
pThingName_,
        $sel:executionNumber:DeleteJobExecution' :: Integer
executionNumber = Integer
pExecutionNumber_
      }

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

-- | 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.
deleteJobExecution_namespaceId :: Lens.Lens' DeleteJobExecution (Prelude.Maybe Prelude.Text)
deleteJobExecution_namespaceId :: Lens' DeleteJobExecution (Maybe Text)
deleteJobExecution_namespaceId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DeleteJobExecution' {Maybe Text
namespaceId :: Maybe Text
$sel:namespaceId:DeleteJobExecution' :: DeleteJobExecution -> Maybe Text
namespaceId} -> Maybe Text
namespaceId) (\s :: DeleteJobExecution
s@DeleteJobExecution' {} Maybe Text
a -> DeleteJobExecution
s {$sel:namespaceId:DeleteJobExecution' :: Maybe Text
namespaceId = Maybe Text
a} :: DeleteJobExecution)

-- | The ID of the job whose execution on a particular device will be
-- deleted.
deleteJobExecution_jobId :: Lens.Lens' DeleteJobExecution Prelude.Text
deleteJobExecution_jobId :: Lens' DeleteJobExecution Text
deleteJobExecution_jobId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DeleteJobExecution' {Text
jobId :: Text
$sel:jobId:DeleteJobExecution' :: DeleteJobExecution -> Text
jobId} -> Text
jobId) (\s :: DeleteJobExecution
s@DeleteJobExecution' {} Text
a -> DeleteJobExecution
s {$sel:jobId:DeleteJobExecution' :: Text
jobId = Text
a} :: DeleteJobExecution)

-- | The name of the thing whose job execution will be deleted.
deleteJobExecution_thingName :: Lens.Lens' DeleteJobExecution Prelude.Text
deleteJobExecution_thingName :: Lens' DeleteJobExecution Text
deleteJobExecution_thingName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DeleteJobExecution' {Text
thingName :: Text
$sel:thingName:DeleteJobExecution' :: DeleteJobExecution -> Text
thingName} -> Text
thingName) (\s :: DeleteJobExecution
s@DeleteJobExecution' {} Text
a -> DeleteJobExecution
s {$sel:thingName:DeleteJobExecution' :: Text
thingName = Text
a} :: DeleteJobExecution)

-- | The ID of the job execution to be deleted. The @executionNumber@ refers
-- to the execution of a particular job on a particular device.
--
-- Note that once a job execution is deleted, the @executionNumber@ may be
-- reused by IoT, so be sure you get and use the correct value here.
deleteJobExecution_executionNumber :: Lens.Lens' DeleteJobExecution Prelude.Integer
deleteJobExecution_executionNumber :: Lens' DeleteJobExecution Integer
deleteJobExecution_executionNumber = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DeleteJobExecution' {Integer
executionNumber :: Integer
$sel:executionNumber:DeleteJobExecution' :: DeleteJobExecution -> Integer
executionNumber} -> Integer
executionNumber) (\s :: DeleteJobExecution
s@DeleteJobExecution' {} Integer
a -> DeleteJobExecution
s {$sel:executionNumber:DeleteJobExecution' :: Integer
executionNumber = Integer
a} :: DeleteJobExecution)

instance Core.AWSRequest DeleteJobExecution where
  type
    AWSResponse DeleteJobExecution =
      DeleteJobExecutionResponse
  request :: (Service -> Service)
-> DeleteJobExecution -> Request DeleteJobExecution
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 DeleteJobExecution
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse DeleteJobExecution)))
response =
    forall (m :: * -> *) a.
MonadResource m =>
AWSResponse a
-> (ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy a
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse a)))
Response.receiveNull DeleteJobExecutionResponse
DeleteJobExecutionResponse'

instance Prelude.Hashable DeleteJobExecution where
  hashWithSalt :: Int -> DeleteJobExecution -> Int
hashWithSalt Int
_salt DeleteJobExecution' {Integer
Maybe Bool
Maybe Text
Text
executionNumber :: Integer
thingName :: Text
jobId :: Text
namespaceId :: Maybe Text
force :: Maybe Bool
$sel:executionNumber:DeleteJobExecution' :: DeleteJobExecution -> Integer
$sel:thingName:DeleteJobExecution' :: DeleteJobExecution -> Text
$sel:jobId:DeleteJobExecution' :: DeleteJobExecution -> Text
$sel:namespaceId:DeleteJobExecution' :: DeleteJobExecution -> Maybe Text
$sel:force:DeleteJobExecution' :: DeleteJobExecution -> 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
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
thingName
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Integer
executionNumber

instance Prelude.NFData DeleteJobExecution where
  rnf :: DeleteJobExecution -> ()
rnf DeleteJobExecution' {Integer
Maybe Bool
Maybe Text
Text
executionNumber :: Integer
thingName :: Text
jobId :: Text
namespaceId :: Maybe Text
force :: Maybe Bool
$sel:executionNumber:DeleteJobExecution' :: DeleteJobExecution -> Integer
$sel:thingName:DeleteJobExecution' :: DeleteJobExecution -> Text
$sel:jobId:DeleteJobExecution' :: DeleteJobExecution -> Text
$sel:namespaceId:DeleteJobExecution' :: DeleteJobExecution -> Maybe Text
$sel:force:DeleteJobExecution' :: DeleteJobExecution -> 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
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
thingName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Integer
executionNumber

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

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

instance Data.ToQuery DeleteJobExecution where
  toQuery :: DeleteJobExecution -> QueryString
toQuery DeleteJobExecution' {Integer
Maybe Bool
Maybe Text
Text
executionNumber :: Integer
thingName :: Text
jobId :: Text
namespaceId :: Maybe Text
force :: Maybe Bool
$sel:executionNumber:DeleteJobExecution' :: DeleteJobExecution -> Integer
$sel:thingName:DeleteJobExecution' :: DeleteJobExecution -> Text
$sel:jobId:DeleteJobExecution' :: DeleteJobExecution -> Text
$sel:namespaceId:DeleteJobExecution' :: DeleteJobExecution -> Maybe Text
$sel:force:DeleteJobExecution' :: DeleteJobExecution -> 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:/ 'newDeleteJobExecutionResponse' smart constructor.
data DeleteJobExecutionResponse = DeleteJobExecutionResponse'
  {
  }
  deriving (DeleteJobExecutionResponse -> DeleteJobExecutionResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DeleteJobExecutionResponse -> DeleteJobExecutionResponse -> Bool
$c/= :: DeleteJobExecutionResponse -> DeleteJobExecutionResponse -> Bool
== :: DeleteJobExecutionResponse -> DeleteJobExecutionResponse -> Bool
$c== :: DeleteJobExecutionResponse -> DeleteJobExecutionResponse -> Bool
Prelude.Eq, ReadPrec [DeleteJobExecutionResponse]
ReadPrec DeleteJobExecutionResponse
Int -> ReadS DeleteJobExecutionResponse
ReadS [DeleteJobExecutionResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DeleteJobExecutionResponse]
$creadListPrec :: ReadPrec [DeleteJobExecutionResponse]
readPrec :: ReadPrec DeleteJobExecutionResponse
$creadPrec :: ReadPrec DeleteJobExecutionResponse
readList :: ReadS [DeleteJobExecutionResponse]
$creadList :: ReadS [DeleteJobExecutionResponse]
readsPrec :: Int -> ReadS DeleteJobExecutionResponse
$creadsPrec :: Int -> ReadS DeleteJobExecutionResponse
Prelude.Read, Int -> DeleteJobExecutionResponse -> ShowS
[DeleteJobExecutionResponse] -> ShowS
DeleteJobExecutionResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DeleteJobExecutionResponse] -> ShowS
$cshowList :: [DeleteJobExecutionResponse] -> ShowS
show :: DeleteJobExecutionResponse -> String
$cshow :: DeleteJobExecutionResponse -> String
showsPrec :: Int -> DeleteJobExecutionResponse -> ShowS
$cshowsPrec :: Int -> DeleteJobExecutionResponse -> ShowS
Prelude.Show, forall x.
Rep DeleteJobExecutionResponse x -> DeleteJobExecutionResponse
forall x.
DeleteJobExecutionResponse -> Rep DeleteJobExecutionResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep DeleteJobExecutionResponse x -> DeleteJobExecutionResponse
$cfrom :: forall x.
DeleteJobExecutionResponse -> Rep DeleteJobExecutionResponse x
Prelude.Generic)

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

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