{-# 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.CreateDynamicThingGroup
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Creates 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 CreateDynamicThingGroup>
-- action.
module Amazonka.IoT.CreateDynamicThingGroup
  ( -- * Creating a Request
    CreateDynamicThingGroup (..),
    newCreateDynamicThingGroup,

    -- * Request Lenses
    createDynamicThingGroup_indexName,
    createDynamicThingGroup_queryVersion,
    createDynamicThingGroup_tags,
    createDynamicThingGroup_thingGroupProperties,
    createDynamicThingGroup_thingGroupName,
    createDynamicThingGroup_queryString,

    -- * Destructuring the Response
    CreateDynamicThingGroupResponse (..),
    newCreateDynamicThingGroupResponse,

    -- * Response Lenses
    createDynamicThingGroupResponse_indexName,
    createDynamicThingGroupResponse_queryString,
    createDynamicThingGroupResponse_queryVersion,
    createDynamicThingGroupResponse_thingGroupArn,
    createDynamicThingGroupResponse_thingGroupId,
    createDynamicThingGroupResponse_thingGroupName,
    createDynamicThingGroupResponse_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:/ 'newCreateDynamicThingGroup' smart constructor.
data CreateDynamicThingGroup = CreateDynamicThingGroup'
  { -- | The dynamic thing group index name.
    --
    -- Currently one index is supported: @AWS_Things@.
    CreateDynamicThingGroup -> Maybe Text
indexName :: Prelude.Maybe Prelude.Text,
    -- | The dynamic thing group query version.
    --
    -- Currently one query version is supported: \"2017-09-30\". If not
    -- specified, the query version defaults to this value.
    CreateDynamicThingGroup -> Maybe Text
queryVersion :: Prelude.Maybe Prelude.Text,
    -- | Metadata which can be used to manage the dynamic thing group.
    CreateDynamicThingGroup -> Maybe [Tag]
tags :: Prelude.Maybe [Tag],
    -- | The dynamic thing group properties.
    CreateDynamicThingGroup -> Maybe ThingGroupProperties
thingGroupProperties :: Prelude.Maybe ThingGroupProperties,
    -- | The dynamic thing group name to create.
    CreateDynamicThingGroup -> Text
thingGroupName :: Prelude.Text,
    -- | The dynamic thing group search query string.
    --
    -- See
    -- <https://docs.aws.amazon.com/iot/latest/developerguide/query-syntax.html Query Syntax>
    -- for information about query string syntax.
    CreateDynamicThingGroup -> Text
queryString :: Prelude.Text
  }
  deriving (CreateDynamicThingGroup -> CreateDynamicThingGroup -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateDynamicThingGroup -> CreateDynamicThingGroup -> Bool
$c/= :: CreateDynamicThingGroup -> CreateDynamicThingGroup -> Bool
== :: CreateDynamicThingGroup -> CreateDynamicThingGroup -> Bool
$c== :: CreateDynamicThingGroup -> CreateDynamicThingGroup -> Bool
Prelude.Eq, ReadPrec [CreateDynamicThingGroup]
ReadPrec CreateDynamicThingGroup
Int -> ReadS CreateDynamicThingGroup
ReadS [CreateDynamicThingGroup]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CreateDynamicThingGroup]
$creadListPrec :: ReadPrec [CreateDynamicThingGroup]
readPrec :: ReadPrec CreateDynamicThingGroup
$creadPrec :: ReadPrec CreateDynamicThingGroup
readList :: ReadS [CreateDynamicThingGroup]
$creadList :: ReadS [CreateDynamicThingGroup]
readsPrec :: Int -> ReadS CreateDynamicThingGroup
$creadsPrec :: Int -> ReadS CreateDynamicThingGroup
Prelude.Read, Int -> CreateDynamicThingGroup -> ShowS
[CreateDynamicThingGroup] -> ShowS
CreateDynamicThingGroup -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateDynamicThingGroup] -> ShowS
$cshowList :: [CreateDynamicThingGroup] -> ShowS
show :: CreateDynamicThingGroup -> String
$cshow :: CreateDynamicThingGroup -> String
showsPrec :: Int -> CreateDynamicThingGroup -> ShowS
$cshowsPrec :: Int -> CreateDynamicThingGroup -> ShowS
Prelude.Show, forall x. Rep CreateDynamicThingGroup x -> CreateDynamicThingGroup
forall x. CreateDynamicThingGroup -> Rep CreateDynamicThingGroup x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CreateDynamicThingGroup x -> CreateDynamicThingGroup
$cfrom :: forall x. CreateDynamicThingGroup -> Rep CreateDynamicThingGroup x
Prelude.Generic)

-- |
-- Create a value of 'CreateDynamicThingGroup' 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:
--
-- 'indexName', 'createDynamicThingGroup_indexName' - The dynamic thing group index name.
--
-- Currently one index is supported: @AWS_Things@.
--
-- 'queryVersion', 'createDynamicThingGroup_queryVersion' - The dynamic thing group query version.
--
-- Currently one query version is supported: \"2017-09-30\". If not
-- specified, the query version defaults to this value.
--
-- 'tags', 'createDynamicThingGroup_tags' - Metadata which can be used to manage the dynamic thing group.
--
-- 'thingGroupProperties', 'createDynamicThingGroup_thingGroupProperties' - The dynamic thing group properties.
--
-- 'thingGroupName', 'createDynamicThingGroup_thingGroupName' - The dynamic thing group name to create.
--
-- 'queryString', 'createDynamicThingGroup_queryString' - The dynamic thing group search query string.
--
-- See
-- <https://docs.aws.amazon.com/iot/latest/developerguide/query-syntax.html Query Syntax>
-- for information about query string syntax.
newCreateDynamicThingGroup ::
  -- | 'thingGroupName'
  Prelude.Text ->
  -- | 'queryString'
  Prelude.Text ->
  CreateDynamicThingGroup
newCreateDynamicThingGroup :: Text -> Text -> CreateDynamicThingGroup
newCreateDynamicThingGroup
  Text
pThingGroupName_
  Text
pQueryString_ =
    CreateDynamicThingGroup'
      { $sel:indexName:CreateDynamicThingGroup' :: Maybe Text
indexName =
          forall a. Maybe a
Prelude.Nothing,
        $sel:queryVersion:CreateDynamicThingGroup' :: Maybe Text
queryVersion = forall a. Maybe a
Prelude.Nothing,
        $sel:tags:CreateDynamicThingGroup' :: Maybe [Tag]
tags = forall a. Maybe a
Prelude.Nothing,
        $sel:thingGroupProperties:CreateDynamicThingGroup' :: Maybe ThingGroupProperties
thingGroupProperties = forall a. Maybe a
Prelude.Nothing,
        $sel:thingGroupName:CreateDynamicThingGroup' :: Text
thingGroupName = Text
pThingGroupName_,
        $sel:queryString:CreateDynamicThingGroup' :: Text
queryString = Text
pQueryString_
      }

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

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

-- | Metadata which can be used to manage the dynamic thing group.
createDynamicThingGroup_tags :: Lens.Lens' CreateDynamicThingGroup (Prelude.Maybe [Tag])
createDynamicThingGroup_tags :: Lens' CreateDynamicThingGroup (Maybe [Tag])
createDynamicThingGroup_tags = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateDynamicThingGroup' {Maybe [Tag]
tags :: Maybe [Tag]
$sel:tags:CreateDynamicThingGroup' :: CreateDynamicThingGroup -> Maybe [Tag]
tags} -> Maybe [Tag]
tags) (\s :: CreateDynamicThingGroup
s@CreateDynamicThingGroup' {} Maybe [Tag]
a -> CreateDynamicThingGroup
s {$sel:tags:CreateDynamicThingGroup' :: Maybe [Tag]
tags = Maybe [Tag]
a} :: CreateDynamicThingGroup) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall (f :: * -> *) (g :: * -> *) s t a b.
(Functor f, Functor g) =>
AnIso s t a b -> Iso (f s) (g t) (f a) (g b)
Lens.mapping forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Lens.coerced

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

-- | The dynamic thing group name to create.
createDynamicThingGroup_thingGroupName :: Lens.Lens' CreateDynamicThingGroup Prelude.Text
createDynamicThingGroup_thingGroupName :: Lens' CreateDynamicThingGroup Text
createDynamicThingGroup_thingGroupName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateDynamicThingGroup' {Text
thingGroupName :: Text
$sel:thingGroupName:CreateDynamicThingGroup' :: CreateDynamicThingGroup -> Text
thingGroupName} -> Text
thingGroupName) (\s :: CreateDynamicThingGroup
s@CreateDynamicThingGroup' {} Text
a -> CreateDynamicThingGroup
s {$sel:thingGroupName:CreateDynamicThingGroup' :: Text
thingGroupName = Text
a} :: CreateDynamicThingGroup)

-- | The dynamic thing group search query string.
--
-- See
-- <https://docs.aws.amazon.com/iot/latest/developerguide/query-syntax.html Query Syntax>
-- for information about query string syntax.
createDynamicThingGroup_queryString :: Lens.Lens' CreateDynamicThingGroup Prelude.Text
createDynamicThingGroup_queryString :: Lens' CreateDynamicThingGroup Text
createDynamicThingGroup_queryString = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateDynamicThingGroup' {Text
queryString :: Text
$sel:queryString:CreateDynamicThingGroup' :: CreateDynamicThingGroup -> Text
queryString} -> Text
queryString) (\s :: CreateDynamicThingGroup
s@CreateDynamicThingGroup' {} Text
a -> CreateDynamicThingGroup
s {$sel:queryString:CreateDynamicThingGroup' :: Text
queryString = Text
a} :: CreateDynamicThingGroup)

instance Core.AWSRequest CreateDynamicThingGroup where
  type
    AWSResponse CreateDynamicThingGroup =
      CreateDynamicThingGroupResponse
  request :: (Service -> Service)
-> CreateDynamicThingGroup -> Request CreateDynamicThingGroup
request Service -> Service
overrides =
    forall a. (ToRequest a, ToJSON a) => Service -> a -> Request a
Request.postJSON (Service -> Service
overrides Service
defaultService)
  response :: forall (m :: * -> *).
MonadResource m =>
(ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy CreateDynamicThingGroup
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse CreateDynamicThingGroup)))
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 Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Int
-> CreateDynamicThingGroupResponse
CreateDynamicThingGroupResponse'
            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
"indexName")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"queryString")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"queryVersion")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"thingGroupArn")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"thingGroupId")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"thingGroupName")
            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 CreateDynamicThingGroup where
  hashWithSalt :: Int -> CreateDynamicThingGroup -> Int
hashWithSalt Int
_salt CreateDynamicThingGroup' {Maybe [Tag]
Maybe Text
Maybe ThingGroupProperties
Text
queryString :: Text
thingGroupName :: Text
thingGroupProperties :: Maybe ThingGroupProperties
tags :: Maybe [Tag]
queryVersion :: Maybe Text
indexName :: Maybe Text
$sel:queryString:CreateDynamicThingGroup' :: CreateDynamicThingGroup -> Text
$sel:thingGroupName:CreateDynamicThingGroup' :: CreateDynamicThingGroup -> Text
$sel:thingGroupProperties:CreateDynamicThingGroup' :: CreateDynamicThingGroup -> Maybe ThingGroupProperties
$sel:tags:CreateDynamicThingGroup' :: CreateDynamicThingGroup -> Maybe [Tag]
$sel:queryVersion:CreateDynamicThingGroup' :: CreateDynamicThingGroup -> Maybe Text
$sel:indexName:CreateDynamicThingGroup' :: CreateDynamicThingGroup -> Maybe Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
indexName
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
queryVersion
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [Tag]
tags
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe ThingGroupProperties
thingGroupProperties
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
thingGroupName
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
queryString

instance Prelude.NFData CreateDynamicThingGroup where
  rnf :: CreateDynamicThingGroup -> ()
rnf CreateDynamicThingGroup' {Maybe [Tag]
Maybe Text
Maybe ThingGroupProperties
Text
queryString :: Text
thingGroupName :: Text
thingGroupProperties :: Maybe ThingGroupProperties
tags :: Maybe [Tag]
queryVersion :: Maybe Text
indexName :: Maybe Text
$sel:queryString:CreateDynamicThingGroup' :: CreateDynamicThingGroup -> Text
$sel:thingGroupName:CreateDynamicThingGroup' :: CreateDynamicThingGroup -> Text
$sel:thingGroupProperties:CreateDynamicThingGroup' :: CreateDynamicThingGroup -> Maybe ThingGroupProperties
$sel:tags:CreateDynamicThingGroup' :: CreateDynamicThingGroup -> Maybe [Tag]
$sel:queryVersion:CreateDynamicThingGroup' :: CreateDynamicThingGroup -> Maybe Text
$sel:indexName:CreateDynamicThingGroup' :: CreateDynamicThingGroup -> Maybe Text
..} =
    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
queryVersion
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [Tag]
tags
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe ThingGroupProperties
thingGroupProperties
      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 Text
queryString

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

instance Data.ToJSON CreateDynamicThingGroup where
  toJSON :: CreateDynamicThingGroup -> Value
toJSON CreateDynamicThingGroup' {Maybe [Tag]
Maybe Text
Maybe ThingGroupProperties
Text
queryString :: Text
thingGroupName :: Text
thingGroupProperties :: Maybe ThingGroupProperties
tags :: Maybe [Tag]
queryVersion :: Maybe Text
indexName :: Maybe Text
$sel:queryString:CreateDynamicThingGroup' :: CreateDynamicThingGroup -> Text
$sel:thingGroupName:CreateDynamicThingGroup' :: CreateDynamicThingGroup -> Text
$sel:thingGroupProperties:CreateDynamicThingGroup' :: CreateDynamicThingGroup -> Maybe ThingGroupProperties
$sel:tags:CreateDynamicThingGroup' :: CreateDynamicThingGroup -> Maybe [Tag]
$sel:queryVersion:CreateDynamicThingGroup' :: CreateDynamicThingGroup -> Maybe Text
$sel:indexName:CreateDynamicThingGroup' :: CreateDynamicThingGroup -> Maybe Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (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
"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,
            (Key
"tags" 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 [Tag]
tags,
            (Key
"thingGroupProperties" 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 ThingGroupProperties
thingGroupProperties,
            forall a. a -> Maybe a
Prelude.Just (Key
"queryString" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
queryString)
          ]
      )

instance Data.ToPath CreateDynamicThingGroup where
  toPath :: CreateDynamicThingGroup -> ByteString
toPath CreateDynamicThingGroup' {Maybe [Tag]
Maybe Text
Maybe ThingGroupProperties
Text
queryString :: Text
thingGroupName :: Text
thingGroupProperties :: Maybe ThingGroupProperties
tags :: Maybe [Tag]
queryVersion :: Maybe Text
indexName :: Maybe Text
$sel:queryString:CreateDynamicThingGroup' :: CreateDynamicThingGroup -> Text
$sel:thingGroupName:CreateDynamicThingGroup' :: CreateDynamicThingGroup -> Text
$sel:thingGroupProperties:CreateDynamicThingGroup' :: CreateDynamicThingGroup -> Maybe ThingGroupProperties
$sel:tags:CreateDynamicThingGroup' :: CreateDynamicThingGroup -> Maybe [Tag]
$sel:queryVersion:CreateDynamicThingGroup' :: CreateDynamicThingGroup -> Maybe Text
$sel:indexName:CreateDynamicThingGroup' :: CreateDynamicThingGroup -> Maybe Text
..} =
    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 CreateDynamicThingGroup where
  toQuery :: CreateDynamicThingGroup -> QueryString
toQuery = forall a b. a -> b -> a
Prelude.const forall a. Monoid a => a
Prelude.mempty

-- | /See:/ 'newCreateDynamicThingGroupResponse' smart constructor.
data CreateDynamicThingGroupResponse = CreateDynamicThingGroupResponse'
  { -- | The dynamic thing group index name.
    CreateDynamicThingGroupResponse -> Maybe Text
indexName :: Prelude.Maybe Prelude.Text,
    -- | The dynamic thing group search query string.
    CreateDynamicThingGroupResponse -> Maybe Text
queryString :: Prelude.Maybe Prelude.Text,
    -- | The dynamic thing group query version.
    CreateDynamicThingGroupResponse -> Maybe Text
queryVersion :: Prelude.Maybe Prelude.Text,
    -- | The dynamic thing group ARN.
    CreateDynamicThingGroupResponse -> Maybe Text
thingGroupArn :: Prelude.Maybe Prelude.Text,
    -- | The dynamic thing group ID.
    CreateDynamicThingGroupResponse -> Maybe Text
thingGroupId :: Prelude.Maybe Prelude.Text,
    -- | The dynamic thing group name.
    CreateDynamicThingGroupResponse -> Maybe Text
thingGroupName :: Prelude.Maybe Prelude.Text,
    -- | The response's http status code.
    CreateDynamicThingGroupResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (CreateDynamicThingGroupResponse
-> CreateDynamicThingGroupResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateDynamicThingGroupResponse
-> CreateDynamicThingGroupResponse -> Bool
$c/= :: CreateDynamicThingGroupResponse
-> CreateDynamicThingGroupResponse -> Bool
== :: CreateDynamicThingGroupResponse
-> CreateDynamicThingGroupResponse -> Bool
$c== :: CreateDynamicThingGroupResponse
-> CreateDynamicThingGroupResponse -> Bool
Prelude.Eq, ReadPrec [CreateDynamicThingGroupResponse]
ReadPrec CreateDynamicThingGroupResponse
Int -> ReadS CreateDynamicThingGroupResponse
ReadS [CreateDynamicThingGroupResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CreateDynamicThingGroupResponse]
$creadListPrec :: ReadPrec [CreateDynamicThingGroupResponse]
readPrec :: ReadPrec CreateDynamicThingGroupResponse
$creadPrec :: ReadPrec CreateDynamicThingGroupResponse
readList :: ReadS [CreateDynamicThingGroupResponse]
$creadList :: ReadS [CreateDynamicThingGroupResponse]
readsPrec :: Int -> ReadS CreateDynamicThingGroupResponse
$creadsPrec :: Int -> ReadS CreateDynamicThingGroupResponse
Prelude.Read, Int -> CreateDynamicThingGroupResponse -> ShowS
[CreateDynamicThingGroupResponse] -> ShowS
CreateDynamicThingGroupResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateDynamicThingGroupResponse] -> ShowS
$cshowList :: [CreateDynamicThingGroupResponse] -> ShowS
show :: CreateDynamicThingGroupResponse -> String
$cshow :: CreateDynamicThingGroupResponse -> String
showsPrec :: Int -> CreateDynamicThingGroupResponse -> ShowS
$cshowsPrec :: Int -> CreateDynamicThingGroupResponse -> ShowS
Prelude.Show, forall x.
Rep CreateDynamicThingGroupResponse x
-> CreateDynamicThingGroupResponse
forall x.
CreateDynamicThingGroupResponse
-> Rep CreateDynamicThingGroupResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep CreateDynamicThingGroupResponse x
-> CreateDynamicThingGroupResponse
$cfrom :: forall x.
CreateDynamicThingGroupResponse
-> Rep CreateDynamicThingGroupResponse x
Prelude.Generic)

-- |
-- Create a value of 'CreateDynamicThingGroupResponse' 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:
--
-- 'indexName', 'createDynamicThingGroupResponse_indexName' - The dynamic thing group index name.
--
-- 'queryString', 'createDynamicThingGroupResponse_queryString' - The dynamic thing group search query string.
--
-- 'queryVersion', 'createDynamicThingGroupResponse_queryVersion' - The dynamic thing group query version.
--
-- 'thingGroupArn', 'createDynamicThingGroupResponse_thingGroupArn' - The dynamic thing group ARN.
--
-- 'thingGroupId', 'createDynamicThingGroupResponse_thingGroupId' - The dynamic thing group ID.
--
-- 'thingGroupName', 'createDynamicThingGroupResponse_thingGroupName' - The dynamic thing group name.
--
-- 'httpStatus', 'createDynamicThingGroupResponse_httpStatus' - The response's http status code.
newCreateDynamicThingGroupResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  CreateDynamicThingGroupResponse
newCreateDynamicThingGroupResponse :: Int -> CreateDynamicThingGroupResponse
newCreateDynamicThingGroupResponse Int
pHttpStatus_ =
  CreateDynamicThingGroupResponse'
    { $sel:indexName:CreateDynamicThingGroupResponse' :: Maybe Text
indexName =
        forall a. Maybe a
Prelude.Nothing,
      $sel:queryString:CreateDynamicThingGroupResponse' :: Maybe Text
queryString = forall a. Maybe a
Prelude.Nothing,
      $sel:queryVersion:CreateDynamicThingGroupResponse' :: Maybe Text
queryVersion = forall a. Maybe a
Prelude.Nothing,
      $sel:thingGroupArn:CreateDynamicThingGroupResponse' :: Maybe Text
thingGroupArn = forall a. Maybe a
Prelude.Nothing,
      $sel:thingGroupId:CreateDynamicThingGroupResponse' :: Maybe Text
thingGroupId = forall a. Maybe a
Prelude.Nothing,
      $sel:thingGroupName:CreateDynamicThingGroupResponse' :: Maybe Text
thingGroupName = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:CreateDynamicThingGroupResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | The dynamic thing group index name.
createDynamicThingGroupResponse_indexName :: Lens.Lens' CreateDynamicThingGroupResponse (Prelude.Maybe Prelude.Text)
createDynamicThingGroupResponse_indexName :: Lens' CreateDynamicThingGroupResponse (Maybe Text)
createDynamicThingGroupResponse_indexName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateDynamicThingGroupResponse' {Maybe Text
indexName :: Maybe Text
$sel:indexName:CreateDynamicThingGroupResponse' :: CreateDynamicThingGroupResponse -> Maybe Text
indexName} -> Maybe Text
indexName) (\s :: CreateDynamicThingGroupResponse
s@CreateDynamicThingGroupResponse' {} Maybe Text
a -> CreateDynamicThingGroupResponse
s {$sel:indexName:CreateDynamicThingGroupResponse' :: Maybe Text
indexName = Maybe Text
a} :: CreateDynamicThingGroupResponse)

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

-- | The dynamic thing group query version.
createDynamicThingGroupResponse_queryVersion :: Lens.Lens' CreateDynamicThingGroupResponse (Prelude.Maybe Prelude.Text)
createDynamicThingGroupResponse_queryVersion :: Lens' CreateDynamicThingGroupResponse (Maybe Text)
createDynamicThingGroupResponse_queryVersion = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateDynamicThingGroupResponse' {Maybe Text
queryVersion :: Maybe Text
$sel:queryVersion:CreateDynamicThingGroupResponse' :: CreateDynamicThingGroupResponse -> Maybe Text
queryVersion} -> Maybe Text
queryVersion) (\s :: CreateDynamicThingGroupResponse
s@CreateDynamicThingGroupResponse' {} Maybe Text
a -> CreateDynamicThingGroupResponse
s {$sel:queryVersion:CreateDynamicThingGroupResponse' :: Maybe Text
queryVersion = Maybe Text
a} :: CreateDynamicThingGroupResponse)

-- | The dynamic thing group ARN.
createDynamicThingGroupResponse_thingGroupArn :: Lens.Lens' CreateDynamicThingGroupResponse (Prelude.Maybe Prelude.Text)
createDynamicThingGroupResponse_thingGroupArn :: Lens' CreateDynamicThingGroupResponse (Maybe Text)
createDynamicThingGroupResponse_thingGroupArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateDynamicThingGroupResponse' {Maybe Text
thingGroupArn :: Maybe Text
$sel:thingGroupArn:CreateDynamicThingGroupResponse' :: CreateDynamicThingGroupResponse -> Maybe Text
thingGroupArn} -> Maybe Text
thingGroupArn) (\s :: CreateDynamicThingGroupResponse
s@CreateDynamicThingGroupResponse' {} Maybe Text
a -> CreateDynamicThingGroupResponse
s {$sel:thingGroupArn:CreateDynamicThingGroupResponse' :: Maybe Text
thingGroupArn = Maybe Text
a} :: CreateDynamicThingGroupResponse)

-- | The dynamic thing group ID.
createDynamicThingGroupResponse_thingGroupId :: Lens.Lens' CreateDynamicThingGroupResponse (Prelude.Maybe Prelude.Text)
createDynamicThingGroupResponse_thingGroupId :: Lens' CreateDynamicThingGroupResponse (Maybe Text)
createDynamicThingGroupResponse_thingGroupId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateDynamicThingGroupResponse' {Maybe Text
thingGroupId :: Maybe Text
$sel:thingGroupId:CreateDynamicThingGroupResponse' :: CreateDynamicThingGroupResponse -> Maybe Text
thingGroupId} -> Maybe Text
thingGroupId) (\s :: CreateDynamicThingGroupResponse
s@CreateDynamicThingGroupResponse' {} Maybe Text
a -> CreateDynamicThingGroupResponse
s {$sel:thingGroupId:CreateDynamicThingGroupResponse' :: Maybe Text
thingGroupId = Maybe Text
a} :: CreateDynamicThingGroupResponse)

-- | The dynamic thing group name.
createDynamicThingGroupResponse_thingGroupName :: Lens.Lens' CreateDynamicThingGroupResponse (Prelude.Maybe Prelude.Text)
createDynamicThingGroupResponse_thingGroupName :: Lens' CreateDynamicThingGroupResponse (Maybe Text)
createDynamicThingGroupResponse_thingGroupName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateDynamicThingGroupResponse' {Maybe Text
thingGroupName :: Maybe Text
$sel:thingGroupName:CreateDynamicThingGroupResponse' :: CreateDynamicThingGroupResponse -> Maybe Text
thingGroupName} -> Maybe Text
thingGroupName) (\s :: CreateDynamicThingGroupResponse
s@CreateDynamicThingGroupResponse' {} Maybe Text
a -> CreateDynamicThingGroupResponse
s {$sel:thingGroupName:CreateDynamicThingGroupResponse' :: Maybe Text
thingGroupName = Maybe Text
a} :: CreateDynamicThingGroupResponse)

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

instance
  Prelude.NFData
    CreateDynamicThingGroupResponse
  where
  rnf :: CreateDynamicThingGroupResponse -> ()
rnf CreateDynamicThingGroupResponse' {Int
Maybe Text
httpStatus :: Int
thingGroupName :: Maybe Text
thingGroupId :: Maybe Text
thingGroupArn :: Maybe Text
queryVersion :: Maybe Text
queryString :: Maybe Text
indexName :: Maybe Text
$sel:httpStatus:CreateDynamicThingGroupResponse' :: CreateDynamicThingGroupResponse -> Int
$sel:thingGroupName:CreateDynamicThingGroupResponse' :: CreateDynamicThingGroupResponse -> Maybe Text
$sel:thingGroupId:CreateDynamicThingGroupResponse' :: CreateDynamicThingGroupResponse -> Maybe Text
$sel:thingGroupArn:CreateDynamicThingGroupResponse' :: CreateDynamicThingGroupResponse -> Maybe Text
$sel:queryVersion:CreateDynamicThingGroupResponse' :: CreateDynamicThingGroupResponse -> Maybe Text
$sel:queryString:CreateDynamicThingGroupResponse' :: CreateDynamicThingGroupResponse -> Maybe Text
$sel:indexName:CreateDynamicThingGroupResponse' :: CreateDynamicThingGroupResponse -> Maybe Text
..} =
    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 Maybe Text
thingGroupArn
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
thingGroupId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
thingGroupName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus