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

    -- * Request Lenses
    updateDynamicThingGroup_expectedVersion,
    updateDynamicThingGroup_indexName,
    updateDynamicThingGroup_queryString,
    updateDynamicThingGroup_queryVersion,
    updateDynamicThingGroup_thingGroupName,
    updateDynamicThingGroup_thingGroupProperties,

    -- * Destructuring the Response
    UpdateDynamicThingGroupResponse (..),
    newUpdateDynamicThingGroupResponse,

    -- * Response Lenses
    updateDynamicThingGroupResponse_version,
    updateDynamicThingGroupResponse_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:/ 'newUpdateDynamicThingGroup' smart constructor.
data UpdateDynamicThingGroup = UpdateDynamicThingGroup'
  { -- | The expected version of the dynamic thing group to update.
    UpdateDynamicThingGroup -> Maybe Integer
expectedVersion :: Prelude.Maybe Prelude.Integer,
    -- | The dynamic thing group index to update.
    --
    -- Currently one index is supported: @AWS_Things@.
    UpdateDynamicThingGroup -> Maybe Text
indexName :: Prelude.Maybe Prelude.Text,
    -- | The dynamic thing group search query string to update.
    UpdateDynamicThingGroup -> Maybe Text
queryString :: Prelude.Maybe Prelude.Text,
    -- | The dynamic thing group query version to update.
    --
    -- Currently one query version is supported: \"2017-09-30\". If not
    -- specified, the query version defaults to this value.
    UpdateDynamicThingGroup -> Maybe Text
queryVersion :: Prelude.Maybe Prelude.Text,
    -- | The name of the dynamic thing group to update.
    UpdateDynamicThingGroup -> Text
thingGroupName :: Prelude.Text,
    -- | The dynamic thing group properties to update.
    UpdateDynamicThingGroup -> ThingGroupProperties
thingGroupProperties :: ThingGroupProperties
  }
  deriving (UpdateDynamicThingGroup -> UpdateDynamicThingGroup -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UpdateDynamicThingGroup -> UpdateDynamicThingGroup -> Bool
$c/= :: UpdateDynamicThingGroup -> UpdateDynamicThingGroup -> Bool
== :: UpdateDynamicThingGroup -> UpdateDynamicThingGroup -> Bool
$c== :: UpdateDynamicThingGroup -> UpdateDynamicThingGroup -> Bool
Prelude.Eq, ReadPrec [UpdateDynamicThingGroup]
ReadPrec UpdateDynamicThingGroup
Int -> ReadS UpdateDynamicThingGroup
ReadS [UpdateDynamicThingGroup]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [UpdateDynamicThingGroup]
$creadListPrec :: ReadPrec [UpdateDynamicThingGroup]
readPrec :: ReadPrec UpdateDynamicThingGroup
$creadPrec :: ReadPrec UpdateDynamicThingGroup
readList :: ReadS [UpdateDynamicThingGroup]
$creadList :: ReadS [UpdateDynamicThingGroup]
readsPrec :: Int -> ReadS UpdateDynamicThingGroup
$creadsPrec :: Int -> ReadS UpdateDynamicThingGroup
Prelude.Read, Int -> UpdateDynamicThingGroup -> ShowS
[UpdateDynamicThingGroup] -> ShowS
UpdateDynamicThingGroup -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UpdateDynamicThingGroup] -> ShowS
$cshowList :: [UpdateDynamicThingGroup] -> ShowS
show :: UpdateDynamicThingGroup -> String
$cshow :: UpdateDynamicThingGroup -> String
showsPrec :: Int -> UpdateDynamicThingGroup -> ShowS
$cshowsPrec :: Int -> UpdateDynamicThingGroup -> ShowS
Prelude.Show, forall x. Rep UpdateDynamicThingGroup x -> UpdateDynamicThingGroup
forall x. UpdateDynamicThingGroup -> Rep UpdateDynamicThingGroup x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep UpdateDynamicThingGroup x -> UpdateDynamicThingGroup
$cfrom :: forall x. UpdateDynamicThingGroup -> Rep UpdateDynamicThingGroup x
Prelude.Generic)

-- |
-- Create a value of 'UpdateDynamicThingGroup' 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', 'updateDynamicThingGroup_expectedVersion' - The expected version of the dynamic thing group to update.
--
-- 'indexName', 'updateDynamicThingGroup_indexName' - The dynamic thing group index to update.
--
-- Currently one index is supported: @AWS_Things@.
--
-- 'queryString', 'updateDynamicThingGroup_queryString' - The dynamic thing group search query string to update.
--
-- 'queryVersion', 'updateDynamicThingGroup_queryVersion' - The dynamic thing group query version to update.
--
-- Currently one query version is supported: \"2017-09-30\". If not
-- specified, the query version defaults to this value.
--
-- 'thingGroupName', 'updateDynamicThingGroup_thingGroupName' - The name of the dynamic thing group to update.
--
-- 'thingGroupProperties', 'updateDynamicThingGroup_thingGroupProperties' - The dynamic thing group properties to update.
newUpdateDynamicThingGroup ::
  -- | 'thingGroupName'
  Prelude.Text ->
  -- | 'thingGroupProperties'
  ThingGroupProperties ->
  UpdateDynamicThingGroup
newUpdateDynamicThingGroup :: Text -> ThingGroupProperties -> UpdateDynamicThingGroup
newUpdateDynamicThingGroup
  Text
pThingGroupName_
  ThingGroupProperties
pThingGroupProperties_ =
    UpdateDynamicThingGroup'
      { $sel:expectedVersion:UpdateDynamicThingGroup' :: Maybe Integer
expectedVersion =
          forall a. Maybe a
Prelude.Nothing,
        $sel:indexName:UpdateDynamicThingGroup' :: Maybe Text
indexName = forall a. Maybe a
Prelude.Nothing,
        $sel:queryString:UpdateDynamicThingGroup' :: Maybe Text
queryString = forall a. Maybe a
Prelude.Nothing,
        $sel:queryVersion:UpdateDynamicThingGroup' :: Maybe Text
queryVersion = forall a. Maybe a
Prelude.Nothing,
        $sel:thingGroupName:UpdateDynamicThingGroup' :: Text
thingGroupName = Text
pThingGroupName_,
        $sel:thingGroupProperties:UpdateDynamicThingGroup' :: ThingGroupProperties
thingGroupProperties = ThingGroupProperties
pThingGroupProperties_
      }

-- | The expected version of the dynamic thing group to update.
updateDynamicThingGroup_expectedVersion :: Lens.Lens' UpdateDynamicThingGroup (Prelude.Maybe Prelude.Integer)
updateDynamicThingGroup_expectedVersion :: Lens' UpdateDynamicThingGroup (Maybe Integer)
updateDynamicThingGroup_expectedVersion = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateDynamicThingGroup' {Maybe Integer
expectedVersion :: Maybe Integer
$sel:expectedVersion:UpdateDynamicThingGroup' :: UpdateDynamicThingGroup -> Maybe Integer
expectedVersion} -> Maybe Integer
expectedVersion) (\s :: UpdateDynamicThingGroup
s@UpdateDynamicThingGroup' {} Maybe Integer
a -> UpdateDynamicThingGroup
s {$sel:expectedVersion:UpdateDynamicThingGroup' :: Maybe Integer
expectedVersion = Maybe Integer
a} :: UpdateDynamicThingGroup)

-- | The dynamic thing group index to update.
--
-- Currently one index is supported: @AWS_Things@.
updateDynamicThingGroup_indexName :: Lens.Lens' UpdateDynamicThingGroup (Prelude.Maybe Prelude.Text)
updateDynamicThingGroup_indexName :: Lens' UpdateDynamicThingGroup (Maybe Text)
updateDynamicThingGroup_indexName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateDynamicThingGroup' {Maybe Text
indexName :: Maybe Text
$sel:indexName:UpdateDynamicThingGroup' :: UpdateDynamicThingGroup -> Maybe Text
indexName} -> Maybe Text
indexName) (\s :: UpdateDynamicThingGroup
s@UpdateDynamicThingGroup' {} Maybe Text
a -> UpdateDynamicThingGroup
s {$sel:indexName:UpdateDynamicThingGroup' :: Maybe Text
indexName = Maybe Text
a} :: UpdateDynamicThingGroup)

-- | The dynamic thing group search query string to update.
updateDynamicThingGroup_queryString :: Lens.Lens' UpdateDynamicThingGroup (Prelude.Maybe Prelude.Text)
updateDynamicThingGroup_queryString :: Lens' UpdateDynamicThingGroup (Maybe Text)
updateDynamicThingGroup_queryString = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateDynamicThingGroup' {Maybe Text
queryString :: Maybe Text
$sel:queryString:UpdateDynamicThingGroup' :: UpdateDynamicThingGroup -> Maybe Text
queryString} -> Maybe Text
queryString) (\s :: UpdateDynamicThingGroup
s@UpdateDynamicThingGroup' {} Maybe Text
a -> UpdateDynamicThingGroup
s {$sel:queryString:UpdateDynamicThingGroup' :: Maybe Text
queryString = Maybe Text
a} :: UpdateDynamicThingGroup)

-- | The dynamic thing group query version to update.
--
-- Currently one query version is supported: \"2017-09-30\". If not
-- specified, the query version defaults to this value.
updateDynamicThingGroup_queryVersion :: Lens.Lens' UpdateDynamicThingGroup (Prelude.Maybe Prelude.Text)
updateDynamicThingGroup_queryVersion :: Lens' UpdateDynamicThingGroup (Maybe Text)
updateDynamicThingGroup_queryVersion = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateDynamicThingGroup' {Maybe Text
queryVersion :: Maybe Text
$sel:queryVersion:UpdateDynamicThingGroup' :: UpdateDynamicThingGroup -> Maybe Text
queryVersion} -> Maybe Text
queryVersion) (\s :: UpdateDynamicThingGroup
s@UpdateDynamicThingGroup' {} Maybe Text
a -> UpdateDynamicThingGroup
s {$sel:queryVersion:UpdateDynamicThingGroup' :: Maybe Text
queryVersion = Maybe Text
a} :: UpdateDynamicThingGroup)

-- | The name of the dynamic thing group to update.
updateDynamicThingGroup_thingGroupName :: Lens.Lens' UpdateDynamicThingGroup Prelude.Text
updateDynamicThingGroup_thingGroupName :: Lens' UpdateDynamicThingGroup Text
updateDynamicThingGroup_thingGroupName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateDynamicThingGroup' {Text
thingGroupName :: Text
$sel:thingGroupName:UpdateDynamicThingGroup' :: UpdateDynamicThingGroup -> Text
thingGroupName} -> Text
thingGroupName) (\s :: UpdateDynamicThingGroup
s@UpdateDynamicThingGroup' {} Text
a -> UpdateDynamicThingGroup
s {$sel:thingGroupName:UpdateDynamicThingGroup' :: Text
thingGroupName = Text
a} :: UpdateDynamicThingGroup)

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

instance Core.AWSRequest UpdateDynamicThingGroup where
  type
    AWSResponse UpdateDynamicThingGroup =
      UpdateDynamicThingGroupResponse
  request :: (Service -> Service)
-> UpdateDynamicThingGroup -> Request UpdateDynamicThingGroup
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 UpdateDynamicThingGroup
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse UpdateDynamicThingGroup)))
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 -> UpdateDynamicThingGroupResponse
UpdateDynamicThingGroupResponse'
            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 UpdateDynamicThingGroup where
  hashWithSalt :: Int -> UpdateDynamicThingGroup -> Int
hashWithSalt Int
_salt UpdateDynamicThingGroup' {Maybe Integer
Maybe Text
Text
ThingGroupProperties
thingGroupProperties :: ThingGroupProperties
thingGroupName :: Text
queryVersion :: Maybe Text
queryString :: Maybe Text
indexName :: Maybe Text
expectedVersion :: Maybe Integer
$sel:thingGroupProperties:UpdateDynamicThingGroup' :: UpdateDynamicThingGroup -> ThingGroupProperties
$sel:thingGroupName:UpdateDynamicThingGroup' :: UpdateDynamicThingGroup -> Text
$sel:queryVersion:UpdateDynamicThingGroup' :: UpdateDynamicThingGroup -> Maybe Text
$sel:queryString:UpdateDynamicThingGroup' :: UpdateDynamicThingGroup -> Maybe Text
$sel:indexName:UpdateDynamicThingGroup' :: UpdateDynamicThingGroup -> Maybe Text
$sel:expectedVersion:UpdateDynamicThingGroup' :: UpdateDynamicThingGroup -> 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` Maybe Text
indexName
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
queryString
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
queryVersion
      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 UpdateDynamicThingGroup where
  rnf :: UpdateDynamicThingGroup -> ()
rnf UpdateDynamicThingGroup' {Maybe Integer
Maybe Text
Text
ThingGroupProperties
thingGroupProperties :: ThingGroupProperties
thingGroupName :: Text
queryVersion :: Maybe Text
queryString :: Maybe Text
indexName :: Maybe Text
expectedVersion :: Maybe Integer
$sel:thingGroupProperties:UpdateDynamicThingGroup' :: UpdateDynamicThingGroup -> ThingGroupProperties
$sel:thingGroupName:UpdateDynamicThingGroup' :: UpdateDynamicThingGroup -> Text
$sel:queryVersion:UpdateDynamicThingGroup' :: UpdateDynamicThingGroup -> Maybe Text
$sel:queryString:UpdateDynamicThingGroup' :: UpdateDynamicThingGroup -> Maybe Text
$sel:indexName:UpdateDynamicThingGroup' :: UpdateDynamicThingGroup -> Maybe Text
$sel:expectedVersion:UpdateDynamicThingGroup' :: UpdateDynamicThingGroup -> 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 Maybe Text
indexName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
queryString
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
queryVersion
      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 UpdateDynamicThingGroup where
  toHeaders :: UpdateDynamicThingGroup -> ResponseHeaders
toHeaders = forall a b. a -> b -> a
Prelude.const forall a. Monoid a => a
Prelude.mempty

instance Data.ToJSON UpdateDynamicThingGroup where
  toJSON :: UpdateDynamicThingGroup -> Value
toJSON UpdateDynamicThingGroup' {Maybe Integer
Maybe Text
Text
ThingGroupProperties
thingGroupProperties :: ThingGroupProperties
thingGroupName :: Text
queryVersion :: Maybe Text
queryString :: Maybe Text
indexName :: Maybe Text
expectedVersion :: Maybe Integer
$sel:thingGroupProperties:UpdateDynamicThingGroup' :: UpdateDynamicThingGroup -> ThingGroupProperties
$sel:thingGroupName:UpdateDynamicThingGroup' :: UpdateDynamicThingGroup -> Text
$sel:queryVersion:UpdateDynamicThingGroup' :: UpdateDynamicThingGroup -> Maybe Text
$sel:queryString:UpdateDynamicThingGroup' :: UpdateDynamicThingGroup -> Maybe Text
$sel:indexName:UpdateDynamicThingGroup' :: UpdateDynamicThingGroup -> Maybe Text
$sel:expectedVersion:UpdateDynamicThingGroup' :: UpdateDynamicThingGroup -> 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,
            (Key
"indexName" 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 Text
indexName,
            (Key
"queryString" 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 Text
queryString,
            (Key
"queryVersion" 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 Text
queryVersion,
            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 UpdateDynamicThingGroup where
  toPath :: UpdateDynamicThingGroup -> ByteString
toPath UpdateDynamicThingGroup' {Maybe Integer
Maybe Text
Text
ThingGroupProperties
thingGroupProperties :: ThingGroupProperties
thingGroupName :: Text
queryVersion :: Maybe Text
queryString :: Maybe Text
indexName :: Maybe Text
expectedVersion :: Maybe Integer
$sel:thingGroupProperties:UpdateDynamicThingGroup' :: UpdateDynamicThingGroup -> ThingGroupProperties
$sel:thingGroupName:UpdateDynamicThingGroup' :: UpdateDynamicThingGroup -> Text
$sel:queryVersion:UpdateDynamicThingGroup' :: UpdateDynamicThingGroup -> Maybe Text
$sel:queryString:UpdateDynamicThingGroup' :: UpdateDynamicThingGroup -> Maybe Text
$sel:indexName:UpdateDynamicThingGroup' :: UpdateDynamicThingGroup -> Maybe Text
$sel:expectedVersion:UpdateDynamicThingGroup' :: UpdateDynamicThingGroup -> Maybe Integer
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ByteString
"/dynamic-thing-groups/", forall a. ToByteString a => a -> ByteString
Data.toBS Text
thingGroupName]

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

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

-- |
-- Create a value of 'UpdateDynamicThingGroupResponse' 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', 'updateDynamicThingGroupResponse_version' - The dynamic thing group version.
--
-- 'httpStatus', 'updateDynamicThingGroupResponse_httpStatus' - The response's http status code.
newUpdateDynamicThingGroupResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  UpdateDynamicThingGroupResponse
newUpdateDynamicThingGroupResponse :: Int -> UpdateDynamicThingGroupResponse
newUpdateDynamicThingGroupResponse Int
pHttpStatus_ =
  UpdateDynamicThingGroupResponse'
    { $sel:version:UpdateDynamicThingGroupResponse' :: Maybe Integer
version =
        forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:UpdateDynamicThingGroupResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | The dynamic thing group version.
updateDynamicThingGroupResponse_version :: Lens.Lens' UpdateDynamicThingGroupResponse (Prelude.Maybe Prelude.Integer)
updateDynamicThingGroupResponse_version :: Lens' UpdateDynamicThingGroupResponse (Maybe Integer)
updateDynamicThingGroupResponse_version = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateDynamicThingGroupResponse' {Maybe Integer
version :: Maybe Integer
$sel:version:UpdateDynamicThingGroupResponse' :: UpdateDynamicThingGroupResponse -> Maybe Integer
version} -> Maybe Integer
version) (\s :: UpdateDynamicThingGroupResponse
s@UpdateDynamicThingGroupResponse' {} Maybe Integer
a -> UpdateDynamicThingGroupResponse
s {$sel:version:UpdateDynamicThingGroupResponse' :: Maybe Integer
version = Maybe Integer
a} :: UpdateDynamicThingGroupResponse)

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

instance
  Prelude.NFData
    UpdateDynamicThingGroupResponse
  where
  rnf :: UpdateDynamicThingGroupResponse -> ()
rnf UpdateDynamicThingGroupResponse' {Int
Maybe Integer
httpStatus :: Int
version :: Maybe Integer
$sel:httpStatus:UpdateDynamicThingGroupResponse' :: UpdateDynamicThingGroupResponse -> Int
$sel:version:UpdateDynamicThingGroupResponse' :: UpdateDynamicThingGroupResponse -> 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