{-# 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.LookoutEquipment.CreateLabelGroup
-- 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 group of labels.
module Amazonka.LookoutEquipment.CreateLabelGroup
  ( -- * Creating a Request
    CreateLabelGroup (..),
    newCreateLabelGroup,

    -- * Request Lenses
    createLabelGroup_faultCodes,
    createLabelGroup_tags,
    createLabelGroup_labelGroupName,
    createLabelGroup_clientToken,

    -- * Destructuring the Response
    CreateLabelGroupResponse (..),
    newCreateLabelGroupResponse,

    -- * Response Lenses
    createLabelGroupResponse_labelGroupArn,
    createLabelGroupResponse_labelGroupName,
    createLabelGroupResponse_httpStatus,
  )
where

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

-- | /See:/ 'newCreateLabelGroup' smart constructor.
data CreateLabelGroup = CreateLabelGroup'
  { -- | The acceptable fault codes (indicating the type of anomaly associated
    -- with the label) that can be used with this label group.
    --
    -- Data in this field will be retained for service usage. Follow best
    -- practices for the security of your data.
    CreateLabelGroup -> Maybe [Text]
faultCodes :: Prelude.Maybe [Prelude.Text],
    -- | Tags that provide metadata about the label group you are creating.
    --
    -- Data in this field will be retained for service usage. Follow best
    -- practices for the security of your data.
    CreateLabelGroup -> Maybe [Tag]
tags :: Prelude.Maybe [Tag],
    -- | Names a group of labels.
    --
    -- Data in this field will be retained for service usage. Follow best
    -- practices for the security of your data.
    CreateLabelGroup -> Text
labelGroupName :: Prelude.Text,
    -- | A unique identifier for the request to create a label group. If you do
    -- not set the client request token, Lookout for Equipment generates one.
    CreateLabelGroup -> Text
clientToken :: Prelude.Text
  }
  deriving (CreateLabelGroup -> CreateLabelGroup -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateLabelGroup -> CreateLabelGroup -> Bool
$c/= :: CreateLabelGroup -> CreateLabelGroup -> Bool
== :: CreateLabelGroup -> CreateLabelGroup -> Bool
$c== :: CreateLabelGroup -> CreateLabelGroup -> Bool
Prelude.Eq, ReadPrec [CreateLabelGroup]
ReadPrec CreateLabelGroup
Int -> ReadS CreateLabelGroup
ReadS [CreateLabelGroup]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CreateLabelGroup]
$creadListPrec :: ReadPrec [CreateLabelGroup]
readPrec :: ReadPrec CreateLabelGroup
$creadPrec :: ReadPrec CreateLabelGroup
readList :: ReadS [CreateLabelGroup]
$creadList :: ReadS [CreateLabelGroup]
readsPrec :: Int -> ReadS CreateLabelGroup
$creadsPrec :: Int -> ReadS CreateLabelGroup
Prelude.Read, Int -> CreateLabelGroup -> ShowS
[CreateLabelGroup] -> ShowS
CreateLabelGroup -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateLabelGroup] -> ShowS
$cshowList :: [CreateLabelGroup] -> ShowS
show :: CreateLabelGroup -> String
$cshow :: CreateLabelGroup -> String
showsPrec :: Int -> CreateLabelGroup -> ShowS
$cshowsPrec :: Int -> CreateLabelGroup -> ShowS
Prelude.Show, forall x. Rep CreateLabelGroup x -> CreateLabelGroup
forall x. CreateLabelGroup -> Rep CreateLabelGroup x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CreateLabelGroup x -> CreateLabelGroup
$cfrom :: forall x. CreateLabelGroup -> Rep CreateLabelGroup x
Prelude.Generic)

-- |
-- Create a value of 'CreateLabelGroup' 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:
--
-- 'faultCodes', 'createLabelGroup_faultCodes' - The acceptable fault codes (indicating the type of anomaly associated
-- with the label) that can be used with this label group.
--
-- Data in this field will be retained for service usage. Follow best
-- practices for the security of your data.
--
-- 'tags', 'createLabelGroup_tags' - Tags that provide metadata about the label group you are creating.
--
-- Data in this field will be retained for service usage. Follow best
-- practices for the security of your data.
--
-- 'labelGroupName', 'createLabelGroup_labelGroupName' - Names a group of labels.
--
-- Data in this field will be retained for service usage. Follow best
-- practices for the security of your data.
--
-- 'clientToken', 'createLabelGroup_clientToken' - A unique identifier for the request to create a label group. If you do
-- not set the client request token, Lookout for Equipment generates one.
newCreateLabelGroup ::
  -- | 'labelGroupName'
  Prelude.Text ->
  -- | 'clientToken'
  Prelude.Text ->
  CreateLabelGroup
newCreateLabelGroup :: Text -> Text -> CreateLabelGroup
newCreateLabelGroup Text
pLabelGroupName_ Text
pClientToken_ =
  CreateLabelGroup'
    { $sel:faultCodes:CreateLabelGroup' :: Maybe [Text]
faultCodes = forall a. Maybe a
Prelude.Nothing,
      $sel:tags:CreateLabelGroup' :: Maybe [Tag]
tags = forall a. Maybe a
Prelude.Nothing,
      $sel:labelGroupName:CreateLabelGroup' :: Text
labelGroupName = Text
pLabelGroupName_,
      $sel:clientToken:CreateLabelGroup' :: Text
clientToken = Text
pClientToken_
    }

-- | The acceptable fault codes (indicating the type of anomaly associated
-- with the label) that can be used with this label group.
--
-- Data in this field will be retained for service usage. Follow best
-- practices for the security of your data.
createLabelGroup_faultCodes :: Lens.Lens' CreateLabelGroup (Prelude.Maybe [Prelude.Text])
createLabelGroup_faultCodes :: Lens' CreateLabelGroup (Maybe [Text])
createLabelGroup_faultCodes = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateLabelGroup' {Maybe [Text]
faultCodes :: Maybe [Text]
$sel:faultCodes:CreateLabelGroup' :: CreateLabelGroup -> Maybe [Text]
faultCodes} -> Maybe [Text]
faultCodes) (\s :: CreateLabelGroup
s@CreateLabelGroup' {} Maybe [Text]
a -> CreateLabelGroup
s {$sel:faultCodes:CreateLabelGroup' :: Maybe [Text]
faultCodes = Maybe [Text]
a} :: CreateLabelGroup) 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

-- | Tags that provide metadata about the label group you are creating.
--
-- Data in this field will be retained for service usage. Follow best
-- practices for the security of your data.
createLabelGroup_tags :: Lens.Lens' CreateLabelGroup (Prelude.Maybe [Tag])
createLabelGroup_tags :: Lens' CreateLabelGroup (Maybe [Tag])
createLabelGroup_tags = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateLabelGroup' {Maybe [Tag]
tags :: Maybe [Tag]
$sel:tags:CreateLabelGroup' :: CreateLabelGroup -> Maybe [Tag]
tags} -> Maybe [Tag]
tags) (\s :: CreateLabelGroup
s@CreateLabelGroup' {} Maybe [Tag]
a -> CreateLabelGroup
s {$sel:tags:CreateLabelGroup' :: Maybe [Tag]
tags = Maybe [Tag]
a} :: CreateLabelGroup) 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

-- | Names a group of labels.
--
-- Data in this field will be retained for service usage. Follow best
-- practices for the security of your data.
createLabelGroup_labelGroupName :: Lens.Lens' CreateLabelGroup Prelude.Text
createLabelGroup_labelGroupName :: Lens' CreateLabelGroup Text
createLabelGroup_labelGroupName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateLabelGroup' {Text
labelGroupName :: Text
$sel:labelGroupName:CreateLabelGroup' :: CreateLabelGroup -> Text
labelGroupName} -> Text
labelGroupName) (\s :: CreateLabelGroup
s@CreateLabelGroup' {} Text
a -> CreateLabelGroup
s {$sel:labelGroupName:CreateLabelGroup' :: Text
labelGroupName = Text
a} :: CreateLabelGroup)

-- | A unique identifier for the request to create a label group. If you do
-- not set the client request token, Lookout for Equipment generates one.
createLabelGroup_clientToken :: Lens.Lens' CreateLabelGroup Prelude.Text
createLabelGroup_clientToken :: Lens' CreateLabelGroup Text
createLabelGroup_clientToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateLabelGroup' {Text
clientToken :: Text
$sel:clientToken:CreateLabelGroup' :: CreateLabelGroup -> Text
clientToken} -> Text
clientToken) (\s :: CreateLabelGroup
s@CreateLabelGroup' {} Text
a -> CreateLabelGroup
s {$sel:clientToken:CreateLabelGroup' :: Text
clientToken = Text
a} :: CreateLabelGroup)

instance Core.AWSRequest CreateLabelGroup where
  type
    AWSResponse CreateLabelGroup =
      CreateLabelGroupResponse
  request :: (Service -> Service)
-> CreateLabelGroup -> Request CreateLabelGroup
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 CreateLabelGroup
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse CreateLabelGroup)))
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 -> Int -> CreateLabelGroupResponse
CreateLabelGroupResponse'
            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
"LabelGroupArn")
            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
"LabelGroupName")
            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 CreateLabelGroup where
  hashWithSalt :: Int -> CreateLabelGroup -> Int
hashWithSalt Int
_salt CreateLabelGroup' {Maybe [Text]
Maybe [Tag]
Text
clientToken :: Text
labelGroupName :: Text
tags :: Maybe [Tag]
faultCodes :: Maybe [Text]
$sel:clientToken:CreateLabelGroup' :: CreateLabelGroup -> Text
$sel:labelGroupName:CreateLabelGroup' :: CreateLabelGroup -> Text
$sel:tags:CreateLabelGroup' :: CreateLabelGroup -> Maybe [Tag]
$sel:faultCodes:CreateLabelGroup' :: CreateLabelGroup -> Maybe [Text]
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [Text]
faultCodes
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [Tag]
tags
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
labelGroupName
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
clientToken

instance Prelude.NFData CreateLabelGroup where
  rnf :: CreateLabelGroup -> ()
rnf CreateLabelGroup' {Maybe [Text]
Maybe [Tag]
Text
clientToken :: Text
labelGroupName :: Text
tags :: Maybe [Tag]
faultCodes :: Maybe [Text]
$sel:clientToken:CreateLabelGroup' :: CreateLabelGroup -> Text
$sel:labelGroupName:CreateLabelGroup' :: CreateLabelGroup -> Text
$sel:tags:CreateLabelGroup' :: CreateLabelGroup -> Maybe [Tag]
$sel:faultCodes:CreateLabelGroup' :: CreateLabelGroup -> Maybe [Text]
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe [Text]
faultCodes
      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 Text
labelGroupName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
clientToken

instance Data.ToHeaders CreateLabelGroup where
  toHeaders :: CreateLabelGroup -> ResponseHeaders
toHeaders =
    forall a b. a -> b -> a
Prelude.const
      ( forall a. Monoid a => [a] -> a
Prelude.mconcat
          [ HeaderName
"X-Amz-Target"
              forall a. ToHeader a => HeaderName -> a -> ResponseHeaders
Data.=# ( ByteString
"AWSLookoutEquipmentFrontendService.CreateLabelGroup" ::
                          Prelude.ByteString
                      ),
            HeaderName
"Content-Type"
              forall a. ToHeader a => HeaderName -> a -> ResponseHeaders
Data.=# ( ByteString
"application/x-amz-json-1.0" ::
                          Prelude.ByteString
                      )
          ]
      )

instance Data.ToJSON CreateLabelGroup where
  toJSON :: CreateLabelGroup -> Value
toJSON CreateLabelGroup' {Maybe [Text]
Maybe [Tag]
Text
clientToken :: Text
labelGroupName :: Text
tags :: Maybe [Tag]
faultCodes :: Maybe [Text]
$sel:clientToken:CreateLabelGroup' :: CreateLabelGroup -> Text
$sel:labelGroupName:CreateLabelGroup' :: CreateLabelGroup -> Text
$sel:tags:CreateLabelGroup' :: CreateLabelGroup -> Maybe [Tag]
$sel:faultCodes:CreateLabelGroup' :: CreateLabelGroup -> Maybe [Text]
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"FaultCodes" 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]
faultCodes,
            (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,
            forall a. a -> Maybe a
Prelude.Just
              (Key
"LabelGroupName" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
labelGroupName),
            forall a. a -> Maybe a
Prelude.Just (Key
"ClientToken" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
clientToken)
          ]
      )

instance Data.ToPath CreateLabelGroup where
  toPath :: CreateLabelGroup -> ByteString
toPath = forall a b. a -> b -> a
Prelude.const ByteString
"/"

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

-- | /See:/ 'newCreateLabelGroupResponse' smart constructor.
data CreateLabelGroupResponse = CreateLabelGroupResponse'
  { -- | The ARN of the label group that you have created.
    CreateLabelGroupResponse -> Maybe Text
labelGroupArn :: Prelude.Maybe Prelude.Text,
    -- | The name of the label group that you have created. Data in this field
    -- will be retained for service usage. Follow best practices for the
    -- security of your data.
    CreateLabelGroupResponse -> Maybe Text
labelGroupName :: Prelude.Maybe Prelude.Text,
    -- | The response's http status code.
    CreateLabelGroupResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (CreateLabelGroupResponse -> CreateLabelGroupResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateLabelGroupResponse -> CreateLabelGroupResponse -> Bool
$c/= :: CreateLabelGroupResponse -> CreateLabelGroupResponse -> Bool
== :: CreateLabelGroupResponse -> CreateLabelGroupResponse -> Bool
$c== :: CreateLabelGroupResponse -> CreateLabelGroupResponse -> Bool
Prelude.Eq, ReadPrec [CreateLabelGroupResponse]
ReadPrec CreateLabelGroupResponse
Int -> ReadS CreateLabelGroupResponse
ReadS [CreateLabelGroupResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CreateLabelGroupResponse]
$creadListPrec :: ReadPrec [CreateLabelGroupResponse]
readPrec :: ReadPrec CreateLabelGroupResponse
$creadPrec :: ReadPrec CreateLabelGroupResponse
readList :: ReadS [CreateLabelGroupResponse]
$creadList :: ReadS [CreateLabelGroupResponse]
readsPrec :: Int -> ReadS CreateLabelGroupResponse
$creadsPrec :: Int -> ReadS CreateLabelGroupResponse
Prelude.Read, Int -> CreateLabelGroupResponse -> ShowS
[CreateLabelGroupResponse] -> ShowS
CreateLabelGroupResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateLabelGroupResponse] -> ShowS
$cshowList :: [CreateLabelGroupResponse] -> ShowS
show :: CreateLabelGroupResponse -> String
$cshow :: CreateLabelGroupResponse -> String
showsPrec :: Int -> CreateLabelGroupResponse -> ShowS
$cshowsPrec :: Int -> CreateLabelGroupResponse -> ShowS
Prelude.Show, forall x.
Rep CreateLabelGroupResponse x -> CreateLabelGroupResponse
forall x.
CreateLabelGroupResponse -> Rep CreateLabelGroupResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep CreateLabelGroupResponse x -> CreateLabelGroupResponse
$cfrom :: forall x.
CreateLabelGroupResponse -> Rep CreateLabelGroupResponse x
Prelude.Generic)

-- |
-- Create a value of 'CreateLabelGroupResponse' 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:
--
-- 'labelGroupArn', 'createLabelGroupResponse_labelGroupArn' - The ARN of the label group that you have created.
--
-- 'labelGroupName', 'createLabelGroupResponse_labelGroupName' - The name of the label group that you have created. Data in this field
-- will be retained for service usage. Follow best practices for the
-- security of your data.
--
-- 'httpStatus', 'createLabelGroupResponse_httpStatus' - The response's http status code.
newCreateLabelGroupResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  CreateLabelGroupResponse
newCreateLabelGroupResponse :: Int -> CreateLabelGroupResponse
newCreateLabelGroupResponse Int
pHttpStatus_ =
  CreateLabelGroupResponse'
    { $sel:labelGroupArn:CreateLabelGroupResponse' :: Maybe Text
labelGroupArn =
        forall a. Maybe a
Prelude.Nothing,
      $sel:labelGroupName:CreateLabelGroupResponse' :: Maybe Text
labelGroupName = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:CreateLabelGroupResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | The ARN of the label group that you have created.
createLabelGroupResponse_labelGroupArn :: Lens.Lens' CreateLabelGroupResponse (Prelude.Maybe Prelude.Text)
createLabelGroupResponse_labelGroupArn :: Lens' CreateLabelGroupResponse (Maybe Text)
createLabelGroupResponse_labelGroupArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateLabelGroupResponse' {Maybe Text
labelGroupArn :: Maybe Text
$sel:labelGroupArn:CreateLabelGroupResponse' :: CreateLabelGroupResponse -> Maybe Text
labelGroupArn} -> Maybe Text
labelGroupArn) (\s :: CreateLabelGroupResponse
s@CreateLabelGroupResponse' {} Maybe Text
a -> CreateLabelGroupResponse
s {$sel:labelGroupArn:CreateLabelGroupResponse' :: Maybe Text
labelGroupArn = Maybe Text
a} :: CreateLabelGroupResponse)

-- | The name of the label group that you have created. Data in this field
-- will be retained for service usage. Follow best practices for the
-- security of your data.
createLabelGroupResponse_labelGroupName :: Lens.Lens' CreateLabelGroupResponse (Prelude.Maybe Prelude.Text)
createLabelGroupResponse_labelGroupName :: Lens' CreateLabelGroupResponse (Maybe Text)
createLabelGroupResponse_labelGroupName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateLabelGroupResponse' {Maybe Text
labelGroupName :: Maybe Text
$sel:labelGroupName:CreateLabelGroupResponse' :: CreateLabelGroupResponse -> Maybe Text
labelGroupName} -> Maybe Text
labelGroupName) (\s :: CreateLabelGroupResponse
s@CreateLabelGroupResponse' {} Maybe Text
a -> CreateLabelGroupResponse
s {$sel:labelGroupName:CreateLabelGroupResponse' :: Maybe Text
labelGroupName = Maybe Text
a} :: CreateLabelGroupResponse)

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

instance Prelude.NFData CreateLabelGroupResponse where
  rnf :: CreateLabelGroupResponse -> ()
rnf CreateLabelGroupResponse' {Int
Maybe Text
httpStatus :: Int
labelGroupName :: Maybe Text
labelGroupArn :: Maybe Text
$sel:httpStatus:CreateLabelGroupResponse' :: CreateLabelGroupResponse -> Int
$sel:labelGroupName:CreateLabelGroupResponse' :: CreateLabelGroupResponse -> Maybe Text
$sel:labelGroupArn:CreateLabelGroupResponse' :: CreateLabelGroupResponse -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
labelGroupArn
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
labelGroupName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus