{-# 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.DeleteOTAUpdate
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Delete an OTA update.
--
-- Requires permission to access the
-- <https://docs.aws.amazon.com/service-authorization/latest/reference/list_awsiot.html#awsiot-actions-as-permissions DeleteOTAUpdate>
-- action.
module Amazonka.IoT.DeleteOTAUpdate
  ( -- * Creating a Request
    DeleteOTAUpdate (..),
    newDeleteOTAUpdate,

    -- * Request Lenses
    deleteOTAUpdate_deleteStream,
    deleteOTAUpdate_forceDeleteAWSJob,
    deleteOTAUpdate_otaUpdateId,

    -- * Destructuring the Response
    DeleteOTAUpdateResponse (..),
    newDeleteOTAUpdateResponse,

    -- * Response Lenses
    deleteOTAUpdateResponse_httpStatus,
  )
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:/ 'newDeleteOTAUpdate' smart constructor.
data DeleteOTAUpdate = DeleteOTAUpdate'
  { -- | When true, the stream created by the OTAUpdate process is deleted when
    -- the OTA update is deleted. Ignored if the stream specified in the
    -- OTAUpdate is supplied by the user.
    DeleteOTAUpdate -> Maybe Bool
deleteStream :: Prelude.Maybe Prelude.Bool,
    -- | When true, deletes the IoT job created by the OTAUpdate process even if
    -- it is \"IN_PROGRESS\". Otherwise, if the job is not in a terminal state
    -- (\"COMPLETED\" or \"CANCELED\") an exception will occur. The default is
    -- false.
    DeleteOTAUpdate -> Maybe Bool
forceDeleteAWSJob :: Prelude.Maybe Prelude.Bool,
    -- | The ID of the OTA update to delete.
    DeleteOTAUpdate -> Text
otaUpdateId :: Prelude.Text
  }
  deriving (DeleteOTAUpdate -> DeleteOTAUpdate -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DeleteOTAUpdate -> DeleteOTAUpdate -> Bool
$c/= :: DeleteOTAUpdate -> DeleteOTAUpdate -> Bool
== :: DeleteOTAUpdate -> DeleteOTAUpdate -> Bool
$c== :: DeleteOTAUpdate -> DeleteOTAUpdate -> Bool
Prelude.Eq, ReadPrec [DeleteOTAUpdate]
ReadPrec DeleteOTAUpdate
Int -> ReadS DeleteOTAUpdate
ReadS [DeleteOTAUpdate]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DeleteOTAUpdate]
$creadListPrec :: ReadPrec [DeleteOTAUpdate]
readPrec :: ReadPrec DeleteOTAUpdate
$creadPrec :: ReadPrec DeleteOTAUpdate
readList :: ReadS [DeleteOTAUpdate]
$creadList :: ReadS [DeleteOTAUpdate]
readsPrec :: Int -> ReadS DeleteOTAUpdate
$creadsPrec :: Int -> ReadS DeleteOTAUpdate
Prelude.Read, Int -> DeleteOTAUpdate -> ShowS
[DeleteOTAUpdate] -> ShowS
DeleteOTAUpdate -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DeleteOTAUpdate] -> ShowS
$cshowList :: [DeleteOTAUpdate] -> ShowS
show :: DeleteOTAUpdate -> String
$cshow :: DeleteOTAUpdate -> String
showsPrec :: Int -> DeleteOTAUpdate -> ShowS
$cshowsPrec :: Int -> DeleteOTAUpdate -> ShowS
Prelude.Show, forall x. Rep DeleteOTAUpdate x -> DeleteOTAUpdate
forall x. DeleteOTAUpdate -> Rep DeleteOTAUpdate x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep DeleteOTAUpdate x -> DeleteOTAUpdate
$cfrom :: forall x. DeleteOTAUpdate -> Rep DeleteOTAUpdate x
Prelude.Generic)

-- |
-- Create a value of 'DeleteOTAUpdate' 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:
--
-- 'deleteStream', 'deleteOTAUpdate_deleteStream' - When true, the stream created by the OTAUpdate process is deleted when
-- the OTA update is deleted. Ignored if the stream specified in the
-- OTAUpdate is supplied by the user.
--
-- 'forceDeleteAWSJob', 'deleteOTAUpdate_forceDeleteAWSJob' - When true, deletes the IoT job created by the OTAUpdate process even if
-- it is \"IN_PROGRESS\". Otherwise, if the job is not in a terminal state
-- (\"COMPLETED\" or \"CANCELED\") an exception will occur. The default is
-- false.
--
-- 'otaUpdateId', 'deleteOTAUpdate_otaUpdateId' - The ID of the OTA update to delete.
newDeleteOTAUpdate ::
  -- | 'otaUpdateId'
  Prelude.Text ->
  DeleteOTAUpdate
newDeleteOTAUpdate :: Text -> DeleteOTAUpdate
newDeleteOTAUpdate Text
pOtaUpdateId_ =
  DeleteOTAUpdate'
    { $sel:deleteStream:DeleteOTAUpdate' :: Maybe Bool
deleteStream = forall a. Maybe a
Prelude.Nothing,
      $sel:forceDeleteAWSJob:DeleteOTAUpdate' :: Maybe Bool
forceDeleteAWSJob = forall a. Maybe a
Prelude.Nothing,
      $sel:otaUpdateId:DeleteOTAUpdate' :: Text
otaUpdateId = Text
pOtaUpdateId_
    }

-- | When true, the stream created by the OTAUpdate process is deleted when
-- the OTA update is deleted. Ignored if the stream specified in the
-- OTAUpdate is supplied by the user.
deleteOTAUpdate_deleteStream :: Lens.Lens' DeleteOTAUpdate (Prelude.Maybe Prelude.Bool)
deleteOTAUpdate_deleteStream :: Lens' DeleteOTAUpdate (Maybe Bool)
deleteOTAUpdate_deleteStream = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DeleteOTAUpdate' {Maybe Bool
deleteStream :: Maybe Bool
$sel:deleteStream:DeleteOTAUpdate' :: DeleteOTAUpdate -> Maybe Bool
deleteStream} -> Maybe Bool
deleteStream) (\s :: DeleteOTAUpdate
s@DeleteOTAUpdate' {} Maybe Bool
a -> DeleteOTAUpdate
s {$sel:deleteStream:DeleteOTAUpdate' :: Maybe Bool
deleteStream = Maybe Bool
a} :: DeleteOTAUpdate)

-- | When true, deletes the IoT job created by the OTAUpdate process even if
-- it is \"IN_PROGRESS\". Otherwise, if the job is not in a terminal state
-- (\"COMPLETED\" or \"CANCELED\") an exception will occur. The default is
-- false.
deleteOTAUpdate_forceDeleteAWSJob :: Lens.Lens' DeleteOTAUpdate (Prelude.Maybe Prelude.Bool)
deleteOTAUpdate_forceDeleteAWSJob :: Lens' DeleteOTAUpdate (Maybe Bool)
deleteOTAUpdate_forceDeleteAWSJob = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DeleteOTAUpdate' {Maybe Bool
forceDeleteAWSJob :: Maybe Bool
$sel:forceDeleteAWSJob:DeleteOTAUpdate' :: DeleteOTAUpdate -> Maybe Bool
forceDeleteAWSJob} -> Maybe Bool
forceDeleteAWSJob) (\s :: DeleteOTAUpdate
s@DeleteOTAUpdate' {} Maybe Bool
a -> DeleteOTAUpdate
s {$sel:forceDeleteAWSJob:DeleteOTAUpdate' :: Maybe Bool
forceDeleteAWSJob = Maybe Bool
a} :: DeleteOTAUpdate)

-- | The ID of the OTA update to delete.
deleteOTAUpdate_otaUpdateId :: Lens.Lens' DeleteOTAUpdate Prelude.Text
deleteOTAUpdate_otaUpdateId :: Lens' DeleteOTAUpdate Text
deleteOTAUpdate_otaUpdateId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DeleteOTAUpdate' {Text
otaUpdateId :: Text
$sel:otaUpdateId:DeleteOTAUpdate' :: DeleteOTAUpdate -> Text
otaUpdateId} -> Text
otaUpdateId) (\s :: DeleteOTAUpdate
s@DeleteOTAUpdate' {} Text
a -> DeleteOTAUpdate
s {$sel:otaUpdateId:DeleteOTAUpdate' :: Text
otaUpdateId = Text
a} :: DeleteOTAUpdate)

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

instance Prelude.NFData DeleteOTAUpdate where
  rnf :: DeleteOTAUpdate -> ()
rnf DeleteOTAUpdate' {Maybe Bool
Text
otaUpdateId :: Text
forceDeleteAWSJob :: Maybe Bool
deleteStream :: Maybe Bool
$sel:otaUpdateId:DeleteOTAUpdate' :: DeleteOTAUpdate -> Text
$sel:forceDeleteAWSJob:DeleteOTAUpdate' :: DeleteOTAUpdate -> Maybe Bool
$sel:deleteStream:DeleteOTAUpdate' :: DeleteOTAUpdate -> Maybe Bool
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Bool
deleteStream
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Bool
forceDeleteAWSJob
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
otaUpdateId

instance Data.ToHeaders DeleteOTAUpdate where
  toHeaders :: DeleteOTAUpdate -> ResponseHeaders
toHeaders = forall a b. a -> b -> a
Prelude.const forall a. Monoid a => a
Prelude.mempty

instance Data.ToPath DeleteOTAUpdate where
  toPath :: DeleteOTAUpdate -> ByteString
toPath DeleteOTAUpdate' {Maybe Bool
Text
otaUpdateId :: Text
forceDeleteAWSJob :: Maybe Bool
deleteStream :: Maybe Bool
$sel:otaUpdateId:DeleteOTAUpdate' :: DeleteOTAUpdate -> Text
$sel:forceDeleteAWSJob:DeleteOTAUpdate' :: DeleteOTAUpdate -> Maybe Bool
$sel:deleteStream:DeleteOTAUpdate' :: DeleteOTAUpdate -> Maybe Bool
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ByteString
"/otaUpdates/", forall a. ToByteString a => a -> ByteString
Data.toBS Text
otaUpdateId]

instance Data.ToQuery DeleteOTAUpdate where
  toQuery :: DeleteOTAUpdate -> QueryString
toQuery DeleteOTAUpdate' {Maybe Bool
Text
otaUpdateId :: Text
forceDeleteAWSJob :: Maybe Bool
deleteStream :: Maybe Bool
$sel:otaUpdateId:DeleteOTAUpdate' :: DeleteOTAUpdate -> Text
$sel:forceDeleteAWSJob:DeleteOTAUpdate' :: DeleteOTAUpdate -> Maybe Bool
$sel:deleteStream:DeleteOTAUpdate' :: DeleteOTAUpdate -> Maybe Bool
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"deleteStream" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Bool
deleteStream,
        ByteString
"forceDeleteAWSJob" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Bool
forceDeleteAWSJob
      ]

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

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

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

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