{-# 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.UpdateThingShadow
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Updates 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 UpdateThingShadow>
-- action.
--
-- For more information, see
-- <http://docs.aws.amazon.com/iot/latest/developerguide/API_UpdateThingShadow.html UpdateThingShadow>
-- in the IoT Developer Guide.
module Amazonka.IoTData.UpdateThingShadow
  ( -- * Creating a Request
    UpdateThingShadow (..),
    newUpdateThingShadow,

    -- * Request Lenses
    updateThingShadow_shadowName,
    updateThingShadow_thingName,
    updateThingShadow_payload,

    -- * Destructuring the Response
    UpdateThingShadowResponse (..),
    newUpdateThingShadowResponse,

    -- * Response Lenses
    updateThingShadowResponse_payload,
    updateThingShadowResponse_httpStatus,
  )
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 UpdateThingShadow operation.
--
-- /See:/ 'newUpdateThingShadow' smart constructor.
data UpdateThingShadow = UpdateThingShadow'
  { -- | The name of the shadow.
    UpdateThingShadow -> Maybe Text
shadowName :: Prelude.Maybe Prelude.Text,
    -- | The name of the thing.
    UpdateThingShadow -> Text
thingName :: Prelude.Text,
    -- | The state information, in JSON format.
    UpdateThingShadow -> ByteString
payload :: Prelude.ByteString
  }
  deriving (UpdateThingShadow -> UpdateThingShadow -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UpdateThingShadow -> UpdateThingShadow -> Bool
$c/= :: UpdateThingShadow -> UpdateThingShadow -> Bool
== :: UpdateThingShadow -> UpdateThingShadow -> Bool
$c== :: UpdateThingShadow -> UpdateThingShadow -> Bool
Prelude.Eq, Int -> UpdateThingShadow -> ShowS
[UpdateThingShadow] -> ShowS
UpdateThingShadow -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UpdateThingShadow] -> ShowS
$cshowList :: [UpdateThingShadow] -> ShowS
show :: UpdateThingShadow -> String
$cshow :: UpdateThingShadow -> String
showsPrec :: Int -> UpdateThingShadow -> ShowS
$cshowsPrec :: Int -> UpdateThingShadow -> ShowS
Prelude.Show, forall x. Rep UpdateThingShadow x -> UpdateThingShadow
forall x. UpdateThingShadow -> Rep UpdateThingShadow x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep UpdateThingShadow x -> UpdateThingShadow
$cfrom :: forall x. UpdateThingShadow -> Rep UpdateThingShadow x
Prelude.Generic)

-- |
-- Create a value of 'UpdateThingShadow' 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', 'updateThingShadow_shadowName' - The name of the shadow.
--
-- 'thingName', 'updateThingShadow_thingName' - The name of the thing.
--
-- 'payload', 'updateThingShadow_payload' - The state information, in JSON format.
newUpdateThingShadow ::
  -- | 'thingName'
  Prelude.Text ->
  -- | 'payload'
  Prelude.ByteString ->
  UpdateThingShadow
newUpdateThingShadow :: Text -> ByteString -> UpdateThingShadow
newUpdateThingShadow Text
pThingName_ ByteString
pPayload_ =
  UpdateThingShadow'
    { $sel:shadowName:UpdateThingShadow' :: Maybe Text
shadowName = forall a. Maybe a
Prelude.Nothing,
      $sel:thingName:UpdateThingShadow' :: Text
thingName = Text
pThingName_,
      $sel:payload:UpdateThingShadow' :: ByteString
payload = ByteString
pPayload_
    }

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

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

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

instance Core.AWSRequest UpdateThingShadow where
  type
    AWSResponse UpdateThingShadow =
      UpdateThingShadowResponse
  request :: (Service -> Service)
-> UpdateThingShadow -> Request UpdateThingShadow
request Service -> Service
overrides =
    forall a. (ToRequest a, ToBody a) => Service -> a -> Request a
Request.postBody (Service -> Service
overrides Service
defaultService)
  response :: forall (m :: * -> *).
MonadResource m =>
(ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy UpdateThingShadow
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse UpdateThingShadow)))
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 ->
          Maybe ByteString -> Int -> UpdateThingShadowResponse
UpdateThingShadowResponse'
            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. a -> Maybe a
Prelude.Just (coerce :: forall a b. Coercible a b => a -> b
Prelude.coerce ByteString
x)))
            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 UpdateThingShadow where
  hashWithSalt :: Int -> UpdateThingShadow -> Int
hashWithSalt Int
_salt UpdateThingShadow' {Maybe Text
ByteString
Text
payload :: ByteString
thingName :: Text
shadowName :: Maybe Text
$sel:payload:UpdateThingShadow' :: UpdateThingShadow -> ByteString
$sel:thingName:UpdateThingShadow' :: UpdateThingShadow -> Text
$sel:shadowName:UpdateThingShadow' :: UpdateThingShadow -> 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
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` ByteString
payload

instance Prelude.NFData UpdateThingShadow where
  rnf :: UpdateThingShadow -> ()
rnf UpdateThingShadow' {Maybe Text
ByteString
Text
payload :: ByteString
thingName :: Text
shadowName :: Maybe Text
$sel:payload:UpdateThingShadow' :: UpdateThingShadow -> ByteString
$sel:thingName:UpdateThingShadow' :: UpdateThingShadow -> Text
$sel:shadowName:UpdateThingShadow' :: UpdateThingShadow -> 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
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf ByteString
payload

instance Data.ToBody UpdateThingShadow where
  toBody :: UpdateThingShadow -> RequestBody
toBody UpdateThingShadow' {Maybe Text
ByteString
Text
payload :: ByteString
thingName :: Text
shadowName :: Maybe Text
$sel:payload:UpdateThingShadow' :: UpdateThingShadow -> ByteString
$sel:thingName:UpdateThingShadow' :: UpdateThingShadow -> Text
$sel:shadowName:UpdateThingShadow' :: UpdateThingShadow -> Maybe Text
..} = forall a. ToBody a => a -> RequestBody
Data.toBody ByteString
payload

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

instance Data.ToPath UpdateThingShadow where
  toPath :: UpdateThingShadow -> ByteString
toPath UpdateThingShadow' {Maybe Text
ByteString
Text
payload :: ByteString
thingName :: Text
shadowName :: Maybe Text
$sel:payload:UpdateThingShadow' :: UpdateThingShadow -> ByteString
$sel:thingName:UpdateThingShadow' :: UpdateThingShadow -> Text
$sel:shadowName:UpdateThingShadow' :: UpdateThingShadow -> 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 UpdateThingShadow where
  toQuery :: UpdateThingShadow -> QueryString
toQuery UpdateThingShadow' {Maybe Text
ByteString
Text
payload :: ByteString
thingName :: Text
shadowName :: Maybe Text
$sel:payload:UpdateThingShadow' :: UpdateThingShadow -> ByteString
$sel:thingName:UpdateThingShadow' :: UpdateThingShadow -> Text
$sel:shadowName:UpdateThingShadow' :: UpdateThingShadow -> 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 UpdateThingShadow operation.
--
-- /See:/ 'newUpdateThingShadowResponse' smart constructor.
data UpdateThingShadowResponse = UpdateThingShadowResponse'
  { -- | The state information, in JSON format.
    UpdateThingShadowResponse -> Maybe ByteString
payload :: Prelude.Maybe Prelude.ByteString,
    -- | The response's http status code.
    UpdateThingShadowResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (UpdateThingShadowResponse -> UpdateThingShadowResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UpdateThingShadowResponse -> UpdateThingShadowResponse -> Bool
$c/= :: UpdateThingShadowResponse -> UpdateThingShadowResponse -> Bool
== :: UpdateThingShadowResponse -> UpdateThingShadowResponse -> Bool
$c== :: UpdateThingShadowResponse -> UpdateThingShadowResponse -> Bool
Prelude.Eq, Int -> UpdateThingShadowResponse -> ShowS
[UpdateThingShadowResponse] -> ShowS
UpdateThingShadowResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UpdateThingShadowResponse] -> ShowS
$cshowList :: [UpdateThingShadowResponse] -> ShowS
show :: UpdateThingShadowResponse -> String
$cshow :: UpdateThingShadowResponse -> String
showsPrec :: Int -> UpdateThingShadowResponse -> ShowS
$cshowsPrec :: Int -> UpdateThingShadowResponse -> ShowS
Prelude.Show, forall x.
Rep UpdateThingShadowResponse x -> UpdateThingShadowResponse
forall x.
UpdateThingShadowResponse -> Rep UpdateThingShadowResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep UpdateThingShadowResponse x -> UpdateThingShadowResponse
$cfrom :: forall x.
UpdateThingShadowResponse -> Rep UpdateThingShadowResponse x
Prelude.Generic)

-- |
-- Create a value of 'UpdateThingShadowResponse' 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:
--
-- 'payload', 'updateThingShadowResponse_payload' - The state information, in JSON format.
--
-- 'httpStatus', 'updateThingShadowResponse_httpStatus' - The response's http status code.
newUpdateThingShadowResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  UpdateThingShadowResponse
newUpdateThingShadowResponse :: Int -> UpdateThingShadowResponse
newUpdateThingShadowResponse Int
pHttpStatus_ =
  UpdateThingShadowResponse'
    { $sel:payload:UpdateThingShadowResponse' :: Maybe ByteString
payload =
        forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:UpdateThingShadowResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

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

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

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