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

    -- * Request Lenses
    updateThingGroup_expectedVersion,
    updateThingGroup_thingGroupName,
    updateThingGroup_thingGroupProperties,

    -- * Destructuring the Response
    UpdateThingGroupResponse (..),
    newUpdateThingGroupResponse,

    -- * Response Lenses
    updateThingGroupResponse_version,
    updateThingGroupResponse_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:/ 'newUpdateThingGroup' smart constructor.
data UpdateThingGroup = UpdateThingGroup'
  { -- | The expected version of the thing group. If this does not match the
    -- version of the thing group being updated, the update will fail.
    UpdateThingGroup -> Maybe Integer
expectedVersion :: Prelude.Maybe Prelude.Integer,
    -- | The thing group to update.
    UpdateThingGroup -> Text
thingGroupName :: Prelude.Text,
    -- | The thing group properties.
    UpdateThingGroup -> ThingGroupProperties
thingGroupProperties :: ThingGroupProperties
  }
  deriving (UpdateThingGroup -> UpdateThingGroup -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UpdateThingGroup -> UpdateThingGroup -> Bool
$c/= :: UpdateThingGroup -> UpdateThingGroup -> Bool
== :: UpdateThingGroup -> UpdateThingGroup -> Bool
$c== :: UpdateThingGroup -> UpdateThingGroup -> Bool
Prelude.Eq, ReadPrec [UpdateThingGroup]
ReadPrec UpdateThingGroup
Int -> ReadS UpdateThingGroup
ReadS [UpdateThingGroup]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [UpdateThingGroup]
$creadListPrec :: ReadPrec [UpdateThingGroup]
readPrec :: ReadPrec UpdateThingGroup
$creadPrec :: ReadPrec UpdateThingGroup
readList :: ReadS [UpdateThingGroup]
$creadList :: ReadS [UpdateThingGroup]
readsPrec :: Int -> ReadS UpdateThingGroup
$creadsPrec :: Int -> ReadS UpdateThingGroup
Prelude.Read, Int -> UpdateThingGroup -> ShowS
[UpdateThingGroup] -> ShowS
UpdateThingGroup -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UpdateThingGroup] -> ShowS
$cshowList :: [UpdateThingGroup] -> ShowS
show :: UpdateThingGroup -> String
$cshow :: UpdateThingGroup -> String
showsPrec :: Int -> UpdateThingGroup -> ShowS
$cshowsPrec :: Int -> UpdateThingGroup -> ShowS
Prelude.Show, forall x. Rep UpdateThingGroup x -> UpdateThingGroup
forall x. UpdateThingGroup -> Rep UpdateThingGroup x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep UpdateThingGroup x -> UpdateThingGroup
$cfrom :: forall x. UpdateThingGroup -> Rep UpdateThingGroup x
Prelude.Generic)

-- |
-- Create a value of 'UpdateThingGroup' 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:
--
-- 'expectedVersion', 'updateThingGroup_expectedVersion' - The expected version of the thing group. If this does not match the
-- version of the thing group being updated, the update will fail.
--
-- 'thingGroupName', 'updateThingGroup_thingGroupName' - The thing group to update.
--
-- 'thingGroupProperties', 'updateThingGroup_thingGroupProperties' - The thing group properties.
newUpdateThingGroup ::
  -- | 'thingGroupName'
  Prelude.Text ->
  -- | 'thingGroupProperties'
  ThingGroupProperties ->
  UpdateThingGroup
newUpdateThingGroup :: Text -> ThingGroupProperties -> UpdateThingGroup
newUpdateThingGroup
  Text
pThingGroupName_
  ThingGroupProperties
pThingGroupProperties_ =
    UpdateThingGroup'
      { $sel:expectedVersion:UpdateThingGroup' :: Maybe Integer
expectedVersion =
          forall a. Maybe a
Prelude.Nothing,
        $sel:thingGroupName:UpdateThingGroup' :: Text
thingGroupName = Text
pThingGroupName_,
        $sel:thingGroupProperties:UpdateThingGroup' :: ThingGroupProperties
thingGroupProperties = ThingGroupProperties
pThingGroupProperties_
      }

-- | The expected version of the thing group. If this does not match the
-- version of the thing group being updated, the update will fail.
updateThingGroup_expectedVersion :: Lens.Lens' UpdateThingGroup (Prelude.Maybe Prelude.Integer)
updateThingGroup_expectedVersion :: Lens' UpdateThingGroup (Maybe Integer)
updateThingGroup_expectedVersion = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateThingGroup' {Maybe Integer
expectedVersion :: Maybe Integer
$sel:expectedVersion:UpdateThingGroup' :: UpdateThingGroup -> Maybe Integer
expectedVersion} -> Maybe Integer
expectedVersion) (\s :: UpdateThingGroup
s@UpdateThingGroup' {} Maybe Integer
a -> UpdateThingGroup
s {$sel:expectedVersion:UpdateThingGroup' :: Maybe Integer
expectedVersion = Maybe Integer
a} :: UpdateThingGroup)

-- | The thing group to update.
updateThingGroup_thingGroupName :: Lens.Lens' UpdateThingGroup Prelude.Text
updateThingGroup_thingGroupName :: Lens' UpdateThingGroup Text
updateThingGroup_thingGroupName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateThingGroup' {Text
thingGroupName :: Text
$sel:thingGroupName:UpdateThingGroup' :: UpdateThingGroup -> Text
thingGroupName} -> Text
thingGroupName) (\s :: UpdateThingGroup
s@UpdateThingGroup' {} Text
a -> UpdateThingGroup
s {$sel:thingGroupName:UpdateThingGroup' :: Text
thingGroupName = Text
a} :: UpdateThingGroup)

-- | The thing group properties.
updateThingGroup_thingGroupProperties :: Lens.Lens' UpdateThingGroup ThingGroupProperties
updateThingGroup_thingGroupProperties :: Lens' UpdateThingGroup ThingGroupProperties
updateThingGroup_thingGroupProperties = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateThingGroup' {ThingGroupProperties
thingGroupProperties :: ThingGroupProperties
$sel:thingGroupProperties:UpdateThingGroup' :: UpdateThingGroup -> ThingGroupProperties
thingGroupProperties} -> ThingGroupProperties
thingGroupProperties) (\s :: UpdateThingGroup
s@UpdateThingGroup' {} ThingGroupProperties
a -> UpdateThingGroup
s {$sel:thingGroupProperties:UpdateThingGroup' :: ThingGroupProperties
thingGroupProperties = ThingGroupProperties
a} :: UpdateThingGroup)

instance Core.AWSRequest UpdateThingGroup where
  type
    AWSResponse UpdateThingGroup =
      UpdateThingGroupResponse
  request :: (Service -> Service)
-> UpdateThingGroup -> Request UpdateThingGroup
request Service -> Service
overrides =
    forall a. (ToRequest a, ToJSON a) => Service -> a -> Request a
Request.patchJSON (Service -> Service
overrides Service
defaultService)
  response :: forall (m :: * -> *).
MonadResource m =>
(ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy UpdateThingGroup
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse UpdateThingGroup)))
response =
    forall (m :: * -> *) a.
MonadResource m =>
(Int -> ResponseHeaders -> Object -> Either String (AWSResponse a))
-> (ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy a
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse a)))
Response.receiveJSON
      ( \Int
s ResponseHeaders
h Object
x ->
          Maybe Integer -> Int -> UpdateThingGroupResponse
UpdateThingGroupResponse'
            forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"version")
            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 UpdateThingGroup where
  hashWithSalt :: Int -> UpdateThingGroup -> Int
hashWithSalt Int
_salt UpdateThingGroup' {Maybe Integer
Text
ThingGroupProperties
thingGroupProperties :: ThingGroupProperties
thingGroupName :: Text
expectedVersion :: Maybe Integer
$sel:thingGroupProperties:UpdateThingGroup' :: UpdateThingGroup -> ThingGroupProperties
$sel:thingGroupName:UpdateThingGroup' :: UpdateThingGroup -> Text
$sel:expectedVersion:UpdateThingGroup' :: UpdateThingGroup -> Maybe Integer
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Integer
expectedVersion
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
thingGroupName
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` ThingGroupProperties
thingGroupProperties

instance Prelude.NFData UpdateThingGroup where
  rnf :: UpdateThingGroup -> ()
rnf UpdateThingGroup' {Maybe Integer
Text
ThingGroupProperties
thingGroupProperties :: ThingGroupProperties
thingGroupName :: Text
expectedVersion :: Maybe Integer
$sel:thingGroupProperties:UpdateThingGroup' :: UpdateThingGroup -> ThingGroupProperties
$sel:thingGroupName:UpdateThingGroup' :: UpdateThingGroup -> Text
$sel:expectedVersion:UpdateThingGroup' :: UpdateThingGroup -> Maybe Integer
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Integer
expectedVersion
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
thingGroupName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf ThingGroupProperties
thingGroupProperties

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

instance Data.ToJSON UpdateThingGroup where
  toJSON :: UpdateThingGroup -> Value
toJSON UpdateThingGroup' {Maybe Integer
Text
ThingGroupProperties
thingGroupProperties :: ThingGroupProperties
thingGroupName :: Text
expectedVersion :: Maybe Integer
$sel:thingGroupProperties:UpdateThingGroup' :: UpdateThingGroup -> ThingGroupProperties
$sel:thingGroupName:UpdateThingGroup' :: UpdateThingGroup -> Text
$sel:expectedVersion:UpdateThingGroup' :: UpdateThingGroup -> Maybe Integer
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"expectedVersion" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=)
              forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe Integer
expectedVersion,
            forall a. a -> Maybe a
Prelude.Just
              ( Key
"thingGroupProperties"
                  forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= ThingGroupProperties
thingGroupProperties
              )
          ]
      )

instance Data.ToPath UpdateThingGroup where
  toPath :: UpdateThingGroup -> ByteString
toPath UpdateThingGroup' {Maybe Integer
Text
ThingGroupProperties
thingGroupProperties :: ThingGroupProperties
thingGroupName :: Text
expectedVersion :: Maybe Integer
$sel:thingGroupProperties:UpdateThingGroup' :: UpdateThingGroup -> ThingGroupProperties
$sel:thingGroupName:UpdateThingGroup' :: UpdateThingGroup -> Text
$sel:expectedVersion:UpdateThingGroup' :: UpdateThingGroup -> Maybe Integer
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ByteString
"/thing-groups/", forall a. ToByteString a => a -> ByteString
Data.toBS Text
thingGroupName]

instance Data.ToQuery UpdateThingGroup where
  toQuery :: UpdateThingGroup -> QueryString
toQuery = forall a b. a -> b -> a
Prelude.const forall a. Monoid a => a
Prelude.mempty

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

-- |
-- Create a value of 'UpdateThingGroupResponse' 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:
--
-- 'version', 'updateThingGroupResponse_version' - The version of the updated thing group.
--
-- 'httpStatus', 'updateThingGroupResponse_httpStatus' - The response's http status code.
newUpdateThingGroupResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  UpdateThingGroupResponse
newUpdateThingGroupResponse :: Int -> UpdateThingGroupResponse
newUpdateThingGroupResponse Int
pHttpStatus_ =
  UpdateThingGroupResponse'
    { $sel:version:UpdateThingGroupResponse' :: Maybe Integer
version =
        forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:UpdateThingGroupResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | The version of the updated thing group.
updateThingGroupResponse_version :: Lens.Lens' UpdateThingGroupResponse (Prelude.Maybe Prelude.Integer)
updateThingGroupResponse_version :: Lens' UpdateThingGroupResponse (Maybe Integer)
updateThingGroupResponse_version = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateThingGroupResponse' {Maybe Integer
version :: Maybe Integer
$sel:version:UpdateThingGroupResponse' :: UpdateThingGroupResponse -> Maybe Integer
version} -> Maybe Integer
version) (\s :: UpdateThingGroupResponse
s@UpdateThingGroupResponse' {} Maybe Integer
a -> UpdateThingGroupResponse
s {$sel:version:UpdateThingGroupResponse' :: Maybe Integer
version = Maybe Integer
a} :: UpdateThingGroupResponse)

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

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