{-# 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.IoTData.DeleteThingShadow
-- 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 the shadow for the specified thing.
--
-- Requires permission to access the
-- <https://docs.aws.amazon.com/service-authorization/latest/reference/list_awsiot.html#awsiot-actions-as-permissions DeleteThingShadow>
-- action.
--
-- For more information, see
-- <http://docs.aws.amazon.com/iot/latest/developerguide/API_DeleteThingShadow.html DeleteThingShadow>
-- in the IoT Developer Guide.
module Amazonka.IoTData.DeleteThingShadow
  ( -- * Creating a Request
    DeleteThingShadow (..),
    newDeleteThingShadow,

    -- * Request Lenses
    deleteThingShadow_shadowName,
    deleteThingShadow_thingName,

    -- * Destructuring the Response
    DeleteThingShadowResponse (..),
    newDeleteThingShadowResponse,

    -- * Response Lenses
    deleteThingShadowResponse_httpStatus,
    deleteThingShadowResponse_payload,
  )
where

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

-- | The input for the DeleteThingShadow operation.
--
-- /See:/ 'newDeleteThingShadow' smart constructor.
data DeleteThingShadow = DeleteThingShadow'
  { -- | The name of the shadow.
    DeleteThingShadow -> Maybe Text
shadowName :: Prelude.Maybe Prelude.Text,
    -- | The name of the thing.
    DeleteThingShadow -> Text
thingName :: Prelude.Text
  }
  deriving (DeleteThingShadow -> DeleteThingShadow -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DeleteThingShadow -> DeleteThingShadow -> Bool
$c/= :: DeleteThingShadow -> DeleteThingShadow -> Bool
== :: DeleteThingShadow -> DeleteThingShadow -> Bool
$c== :: DeleteThingShadow -> DeleteThingShadow -> Bool
Prelude.Eq, ReadPrec [DeleteThingShadow]
ReadPrec DeleteThingShadow
Int -> ReadS DeleteThingShadow
ReadS [DeleteThingShadow]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DeleteThingShadow]
$creadListPrec :: ReadPrec [DeleteThingShadow]
readPrec :: ReadPrec DeleteThingShadow
$creadPrec :: ReadPrec DeleteThingShadow
readList :: ReadS [DeleteThingShadow]
$creadList :: ReadS [DeleteThingShadow]
readsPrec :: Int -> ReadS DeleteThingShadow
$creadsPrec :: Int -> ReadS DeleteThingShadow
Prelude.Read, Int -> DeleteThingShadow -> ShowS
[DeleteThingShadow] -> ShowS
DeleteThingShadow -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DeleteThingShadow] -> ShowS
$cshowList :: [DeleteThingShadow] -> ShowS
show :: DeleteThingShadow -> String
$cshow :: DeleteThingShadow -> String
showsPrec :: Int -> DeleteThingShadow -> ShowS
$cshowsPrec :: Int -> DeleteThingShadow -> ShowS
Prelude.Show, forall x. Rep DeleteThingShadow x -> DeleteThingShadow
forall x. DeleteThingShadow -> Rep DeleteThingShadow x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep DeleteThingShadow x -> DeleteThingShadow
$cfrom :: forall x. DeleteThingShadow -> Rep DeleteThingShadow x
Prelude.Generic)

-- |
-- Create a value of 'DeleteThingShadow' 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:
--
-- 'shadowName', 'deleteThingShadow_shadowName' - The name of the shadow.
--
-- 'thingName', 'deleteThingShadow_thingName' - The name of the thing.
newDeleteThingShadow ::
  -- | 'thingName'
  Prelude.Text ->
  DeleteThingShadow
newDeleteThingShadow :: Text -> DeleteThingShadow
newDeleteThingShadow Text
pThingName_ =
  DeleteThingShadow'
    { $sel:shadowName:DeleteThingShadow' :: Maybe Text
shadowName = forall a. Maybe a
Prelude.Nothing,
      $sel:thingName:DeleteThingShadow' :: Text
thingName = Text
pThingName_
    }

-- | The name of the shadow.
deleteThingShadow_shadowName :: Lens.Lens' DeleteThingShadow (Prelude.Maybe Prelude.Text)
deleteThingShadow_shadowName :: Lens' DeleteThingShadow (Maybe Text)
deleteThingShadow_shadowName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DeleteThingShadow' {Maybe Text
shadowName :: Maybe Text
$sel:shadowName:DeleteThingShadow' :: DeleteThingShadow -> Maybe Text
shadowName} -> Maybe Text
shadowName) (\s :: DeleteThingShadow
s@DeleteThingShadow' {} Maybe Text
a -> DeleteThingShadow
s {$sel:shadowName:DeleteThingShadow' :: Maybe Text
shadowName = Maybe Text
a} :: DeleteThingShadow)

-- | The name of the thing.
deleteThingShadow_thingName :: Lens.Lens' DeleteThingShadow Prelude.Text
deleteThingShadow_thingName :: Lens' DeleteThingShadow Text
deleteThingShadow_thingName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DeleteThingShadow' {Text
thingName :: Text
$sel:thingName:DeleteThingShadow' :: DeleteThingShadow -> Text
thingName} -> Text
thingName) (\s :: DeleteThingShadow
s@DeleteThingShadow' {} Text
a -> DeleteThingShadow
s {$sel:thingName:DeleteThingShadow' :: Text
thingName = Text
a} :: DeleteThingShadow)

instance Core.AWSRequest DeleteThingShadow where
  type
    AWSResponse DeleteThingShadow =
      DeleteThingShadowResponse
  request :: (Service -> Service)
-> DeleteThingShadow -> Request DeleteThingShadow
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 DeleteThingShadow
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse DeleteThingShadow)))
response =
    forall (m :: * -> *) a.
MonadResource m =>
(Int
 -> ResponseHeaders -> ByteString -> Either String (AWSResponse a))
-> (ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy a
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse a)))
Response.receiveBytes
      ( \Int
s ResponseHeaders
h ByteString
x ->
          Int -> ByteString -> DeleteThingShadowResponse
DeleteThingShadowResponse'
            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))
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (forall (f :: * -> *) a. Applicative f => a -> f a
Prelude.pure ByteString
x)
      )

instance Prelude.Hashable DeleteThingShadow where
  hashWithSalt :: Int -> DeleteThingShadow -> Int
hashWithSalt Int
_salt DeleteThingShadow' {Maybe Text
Text
thingName :: Text
shadowName :: Maybe Text
$sel:thingName:DeleteThingShadow' :: DeleteThingShadow -> Text
$sel:shadowName:DeleteThingShadow' :: DeleteThingShadow -> Maybe Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
shadowName
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
thingName

instance Prelude.NFData DeleteThingShadow where
  rnf :: DeleteThingShadow -> ()
rnf DeleteThingShadow' {Maybe Text
Text
thingName :: Text
shadowName :: Maybe Text
$sel:thingName:DeleteThingShadow' :: DeleteThingShadow -> Text
$sel:shadowName:DeleteThingShadow' :: DeleteThingShadow -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
shadowName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
thingName

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

instance Data.ToPath DeleteThingShadow where
  toPath :: DeleteThingShadow -> ByteString
toPath DeleteThingShadow' {Maybe Text
Text
thingName :: Text
shadowName :: Maybe Text
$sel:thingName:DeleteThingShadow' :: DeleteThingShadow -> Text
$sel:shadowName:DeleteThingShadow' :: DeleteThingShadow -> Maybe Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ByteString
"/things/", forall a. ToByteString a => a -> ByteString
Data.toBS Text
thingName, ByteString
"/shadow"]

instance Data.ToQuery DeleteThingShadow where
  toQuery :: DeleteThingShadow -> QueryString
toQuery DeleteThingShadow' {Maybe Text
Text
thingName :: Text
shadowName :: Maybe Text
$sel:thingName:DeleteThingShadow' :: DeleteThingShadow -> Text
$sel:shadowName:DeleteThingShadow' :: DeleteThingShadow -> Maybe Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat [ByteString
"name" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Text
shadowName]

-- | The output from the DeleteThingShadow operation.
--
-- /See:/ 'newDeleteThingShadowResponse' smart constructor.
data DeleteThingShadowResponse = DeleteThingShadowResponse'
  { -- | The response's http status code.
    DeleteThingShadowResponse -> Int
httpStatus :: Prelude.Int,
    -- | The state information, in JSON format.
    DeleteThingShadowResponse -> ByteString
payload :: Prelude.ByteString
  }
  deriving (DeleteThingShadowResponse -> DeleteThingShadowResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DeleteThingShadowResponse -> DeleteThingShadowResponse -> Bool
$c/= :: DeleteThingShadowResponse -> DeleteThingShadowResponse -> Bool
== :: DeleteThingShadowResponse -> DeleteThingShadowResponse -> Bool
$c== :: DeleteThingShadowResponse -> DeleteThingShadowResponse -> Bool
Prelude.Eq, Int -> DeleteThingShadowResponse -> ShowS
[DeleteThingShadowResponse] -> ShowS
DeleteThingShadowResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DeleteThingShadowResponse] -> ShowS
$cshowList :: [DeleteThingShadowResponse] -> ShowS
show :: DeleteThingShadowResponse -> String
$cshow :: DeleteThingShadowResponse -> String
showsPrec :: Int -> DeleteThingShadowResponse -> ShowS
$cshowsPrec :: Int -> DeleteThingShadowResponse -> ShowS
Prelude.Show, forall x.
Rep DeleteThingShadowResponse x -> DeleteThingShadowResponse
forall x.
DeleteThingShadowResponse -> Rep DeleteThingShadowResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep DeleteThingShadowResponse x -> DeleteThingShadowResponse
$cfrom :: forall x.
DeleteThingShadowResponse -> Rep DeleteThingShadowResponse x
Prelude.Generic)

-- |
-- Create a value of 'DeleteThingShadowResponse' 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', 'deleteThingShadowResponse_httpStatus' - The response's http status code.
--
-- 'payload', 'deleteThingShadowResponse_payload' - The state information, in JSON format.
newDeleteThingShadowResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  -- | 'payload'
  Prelude.ByteString ->
  DeleteThingShadowResponse
newDeleteThingShadowResponse :: Int -> ByteString -> DeleteThingShadowResponse
newDeleteThingShadowResponse Int
pHttpStatus_ ByteString
pPayload_ =
  DeleteThingShadowResponse'
    { $sel:httpStatus:DeleteThingShadowResponse' :: Int
httpStatus =
        Int
pHttpStatus_,
      $sel:payload:DeleteThingShadowResponse' :: ByteString
payload = ByteString
pPayload_
    }

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

-- | The state information, in JSON format.
deleteThingShadowResponse_payload :: Lens.Lens' DeleteThingShadowResponse Prelude.ByteString
deleteThingShadowResponse_payload :: Lens' DeleteThingShadowResponse ByteString
deleteThingShadowResponse_payload = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DeleteThingShadowResponse' {ByteString
payload :: ByteString
$sel:payload:DeleteThingShadowResponse' :: DeleteThingShadowResponse -> ByteString
payload} -> ByteString
payload) (\s :: DeleteThingShadowResponse
s@DeleteThingShadowResponse' {} ByteString
a -> DeleteThingShadowResponse
s {$sel:payload:DeleteThingShadowResponse' :: ByteString
payload = ByteString
a} :: DeleteThingShadowResponse)

instance Prelude.NFData DeleteThingShadowResponse where
  rnf :: DeleteThingShadowResponse -> ()
rnf DeleteThingShadowResponse' {Int
ByteString
payload :: ByteString
httpStatus :: Int
$sel:payload:DeleteThingShadowResponse' :: DeleteThingShadowResponse -> ByteString
$sel:httpStatus:DeleteThingShadowResponse' :: DeleteThingShadowResponse -> Int
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf ByteString
payload