{-# 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.UpdateDimension
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Updates the definition for a dimension. You cannot change the type of a
-- dimension after it is created (you can delete it and recreate it).
--
-- Requires permission to access the
-- <https://docs.aws.amazon.com/service-authorization/latest/reference/list_awsiot.html#awsiot-actions-as-permissions UpdateDimension>
-- action.
module Amazonka.IoT.UpdateDimension
  ( -- * Creating a Request
    UpdateDimension (..),
    newUpdateDimension,

    -- * Request Lenses
    updateDimension_name,
    updateDimension_stringValues,

    -- * Destructuring the Response
    UpdateDimensionResponse (..),
    newUpdateDimensionResponse,

    -- * Response Lenses
    updateDimensionResponse_arn,
    updateDimensionResponse_creationDate,
    updateDimensionResponse_lastModifiedDate,
    updateDimensionResponse_name,
    updateDimensionResponse_stringValues,
    updateDimensionResponse_type,
    updateDimensionResponse_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:/ 'newUpdateDimension' smart constructor.
data UpdateDimension = UpdateDimension'
  { -- | A unique identifier for the dimension. Choose something that describes
    -- the type and value to make it easy to remember what it does.
    UpdateDimension -> Text
name :: Prelude.Text,
    -- | Specifies the value or list of values for the dimension. For
    -- @TOPIC_FILTER@ dimensions, this is a pattern used to match the MQTT
    -- topic (for example, \"admin\/#\").
    UpdateDimension -> NonEmpty Text
stringValues :: Prelude.NonEmpty Prelude.Text
  }
  deriving (UpdateDimension -> UpdateDimension -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UpdateDimension -> UpdateDimension -> Bool
$c/= :: UpdateDimension -> UpdateDimension -> Bool
== :: UpdateDimension -> UpdateDimension -> Bool
$c== :: UpdateDimension -> UpdateDimension -> Bool
Prelude.Eq, ReadPrec [UpdateDimension]
ReadPrec UpdateDimension
Int -> ReadS UpdateDimension
ReadS [UpdateDimension]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [UpdateDimension]
$creadListPrec :: ReadPrec [UpdateDimension]
readPrec :: ReadPrec UpdateDimension
$creadPrec :: ReadPrec UpdateDimension
readList :: ReadS [UpdateDimension]
$creadList :: ReadS [UpdateDimension]
readsPrec :: Int -> ReadS UpdateDimension
$creadsPrec :: Int -> ReadS UpdateDimension
Prelude.Read, Int -> UpdateDimension -> ShowS
[UpdateDimension] -> ShowS
UpdateDimension -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UpdateDimension] -> ShowS
$cshowList :: [UpdateDimension] -> ShowS
show :: UpdateDimension -> String
$cshow :: UpdateDimension -> String
showsPrec :: Int -> UpdateDimension -> ShowS
$cshowsPrec :: Int -> UpdateDimension -> ShowS
Prelude.Show, forall x. Rep UpdateDimension x -> UpdateDimension
forall x. UpdateDimension -> Rep UpdateDimension x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep UpdateDimension x -> UpdateDimension
$cfrom :: forall x. UpdateDimension -> Rep UpdateDimension x
Prelude.Generic)

-- |
-- Create a value of 'UpdateDimension' 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:
--
-- 'name', 'updateDimension_name' - A unique identifier for the dimension. Choose something that describes
-- the type and value to make it easy to remember what it does.
--
-- 'stringValues', 'updateDimension_stringValues' - Specifies the value or list of values for the dimension. For
-- @TOPIC_FILTER@ dimensions, this is a pattern used to match the MQTT
-- topic (for example, \"admin\/#\").
newUpdateDimension ::
  -- | 'name'
  Prelude.Text ->
  -- | 'stringValues'
  Prelude.NonEmpty Prelude.Text ->
  UpdateDimension
newUpdateDimension :: Text -> NonEmpty Text -> UpdateDimension
newUpdateDimension Text
pName_ NonEmpty Text
pStringValues_ =
  UpdateDimension'
    { $sel:name:UpdateDimension' :: Text
name = Text
pName_,
      $sel:stringValues:UpdateDimension' :: NonEmpty Text
stringValues = forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Lens.coerced forall t b. AReview t b -> b -> t
Lens.# NonEmpty Text
pStringValues_
    }

-- | A unique identifier for the dimension. Choose something that describes
-- the type and value to make it easy to remember what it does.
updateDimension_name :: Lens.Lens' UpdateDimension Prelude.Text
updateDimension_name :: Lens' UpdateDimension Text
updateDimension_name = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateDimension' {Text
name :: Text
$sel:name:UpdateDimension' :: UpdateDimension -> Text
name} -> Text
name) (\s :: UpdateDimension
s@UpdateDimension' {} Text
a -> UpdateDimension
s {$sel:name:UpdateDimension' :: Text
name = Text
a} :: UpdateDimension)

-- | Specifies the value or list of values for the dimension. For
-- @TOPIC_FILTER@ dimensions, this is a pattern used to match the MQTT
-- topic (for example, \"admin\/#\").
updateDimension_stringValues :: Lens.Lens' UpdateDimension (Prelude.NonEmpty Prelude.Text)
updateDimension_stringValues :: Lens' UpdateDimension (NonEmpty Text)
updateDimension_stringValues = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateDimension' {NonEmpty Text
stringValues :: NonEmpty Text
$sel:stringValues:UpdateDimension' :: UpdateDimension -> NonEmpty Text
stringValues} -> NonEmpty Text
stringValues) (\s :: UpdateDimension
s@UpdateDimension' {} NonEmpty Text
a -> UpdateDimension
s {$sel:stringValues:UpdateDimension' :: NonEmpty Text
stringValues = NonEmpty Text
a} :: UpdateDimension) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Lens.coerced

instance Core.AWSRequest UpdateDimension where
  type
    AWSResponse UpdateDimension =
      UpdateDimensionResponse
  request :: (Service -> Service) -> UpdateDimension -> Request UpdateDimension
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 UpdateDimension
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse UpdateDimension)))
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 POSIX
-> Maybe POSIX
-> Maybe Text
-> Maybe (NonEmpty Text)
-> Maybe DimensionType
-> Int
-> UpdateDimensionResponse
UpdateDimensionResponse'
            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
"arn")
            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
"creationDate")
            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
"lastModifiedDate")
            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
"name")
            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
"stringValues")
            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
"type")
            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 UpdateDimension where
  hashWithSalt :: Int -> UpdateDimension -> Int
hashWithSalt Int
_salt UpdateDimension' {NonEmpty Text
Text
stringValues :: NonEmpty Text
name :: Text
$sel:stringValues:UpdateDimension' :: UpdateDimension -> NonEmpty Text
$sel:name:UpdateDimension' :: UpdateDimension -> Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
name
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` NonEmpty Text
stringValues

instance Prelude.NFData UpdateDimension where
  rnf :: UpdateDimension -> ()
rnf UpdateDimension' {NonEmpty Text
Text
stringValues :: NonEmpty Text
name :: Text
$sel:stringValues:UpdateDimension' :: UpdateDimension -> NonEmpty Text
$sel:name:UpdateDimension' :: UpdateDimension -> Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Text
name
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf NonEmpty Text
stringValues

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

instance Data.ToJSON UpdateDimension where
  toJSON :: UpdateDimension -> Value
toJSON UpdateDimension' {NonEmpty Text
Text
stringValues :: NonEmpty Text
name :: Text
$sel:stringValues:UpdateDimension' :: UpdateDimension -> NonEmpty Text
$sel:name:UpdateDimension' :: UpdateDimension -> Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [forall a. a -> Maybe a
Prelude.Just (Key
"stringValues" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= NonEmpty Text
stringValues)]
      )

instance Data.ToPath UpdateDimension where
  toPath :: UpdateDimension -> ByteString
toPath UpdateDimension' {NonEmpty Text
Text
stringValues :: NonEmpty Text
name :: Text
$sel:stringValues:UpdateDimension' :: UpdateDimension -> NonEmpty Text
$sel:name:UpdateDimension' :: UpdateDimension -> Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat [ByteString
"/dimensions/", forall a. ToByteString a => a -> ByteString
Data.toBS Text
name]

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

-- | /See:/ 'newUpdateDimensionResponse' smart constructor.
data UpdateDimensionResponse = UpdateDimensionResponse'
  { -- | The Amazon Resource Name (ARN)of the created dimension.
    UpdateDimensionResponse -> Maybe Text
arn :: Prelude.Maybe Prelude.Text,
    -- | The date and time, in milliseconds since epoch, when the dimension was
    -- initially created.
    UpdateDimensionResponse -> Maybe POSIX
creationDate :: Prelude.Maybe Data.POSIX,
    -- | The date and time, in milliseconds since epoch, when the dimension was
    -- most recently updated.
    UpdateDimensionResponse -> Maybe POSIX
lastModifiedDate :: Prelude.Maybe Data.POSIX,
    -- | A unique identifier for the dimension.
    UpdateDimensionResponse -> Maybe Text
name :: Prelude.Maybe Prelude.Text,
    -- | The value or list of values used to scope the dimension. For example,
    -- for topic filters, this is the pattern used to match the MQTT topic
    -- name.
    UpdateDimensionResponse -> Maybe (NonEmpty Text)
stringValues :: Prelude.Maybe (Prelude.NonEmpty Prelude.Text),
    -- | The type of the dimension.
    UpdateDimensionResponse -> Maybe DimensionType
type' :: Prelude.Maybe DimensionType,
    -- | The response's http status code.
    UpdateDimensionResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (UpdateDimensionResponse -> UpdateDimensionResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UpdateDimensionResponse -> UpdateDimensionResponse -> Bool
$c/= :: UpdateDimensionResponse -> UpdateDimensionResponse -> Bool
== :: UpdateDimensionResponse -> UpdateDimensionResponse -> Bool
$c== :: UpdateDimensionResponse -> UpdateDimensionResponse -> Bool
Prelude.Eq, ReadPrec [UpdateDimensionResponse]
ReadPrec UpdateDimensionResponse
Int -> ReadS UpdateDimensionResponse
ReadS [UpdateDimensionResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [UpdateDimensionResponse]
$creadListPrec :: ReadPrec [UpdateDimensionResponse]
readPrec :: ReadPrec UpdateDimensionResponse
$creadPrec :: ReadPrec UpdateDimensionResponse
readList :: ReadS [UpdateDimensionResponse]
$creadList :: ReadS [UpdateDimensionResponse]
readsPrec :: Int -> ReadS UpdateDimensionResponse
$creadsPrec :: Int -> ReadS UpdateDimensionResponse
Prelude.Read, Int -> UpdateDimensionResponse -> ShowS
[UpdateDimensionResponse] -> ShowS
UpdateDimensionResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UpdateDimensionResponse] -> ShowS
$cshowList :: [UpdateDimensionResponse] -> ShowS
show :: UpdateDimensionResponse -> String
$cshow :: UpdateDimensionResponse -> String
showsPrec :: Int -> UpdateDimensionResponse -> ShowS
$cshowsPrec :: Int -> UpdateDimensionResponse -> ShowS
Prelude.Show, forall x. Rep UpdateDimensionResponse x -> UpdateDimensionResponse
forall x. UpdateDimensionResponse -> Rep UpdateDimensionResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep UpdateDimensionResponse x -> UpdateDimensionResponse
$cfrom :: forall x. UpdateDimensionResponse -> Rep UpdateDimensionResponse x
Prelude.Generic)

-- |
-- Create a value of 'UpdateDimensionResponse' 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:
--
-- 'arn', 'updateDimensionResponse_arn' - The Amazon Resource Name (ARN)of the created dimension.
--
-- 'creationDate', 'updateDimensionResponse_creationDate' - The date and time, in milliseconds since epoch, when the dimension was
-- initially created.
--
-- 'lastModifiedDate', 'updateDimensionResponse_lastModifiedDate' - The date and time, in milliseconds since epoch, when the dimension was
-- most recently updated.
--
-- 'name', 'updateDimensionResponse_name' - A unique identifier for the dimension.
--
-- 'stringValues', 'updateDimensionResponse_stringValues' - The value or list of values used to scope the dimension. For example,
-- for topic filters, this is the pattern used to match the MQTT topic
-- name.
--
-- 'type'', 'updateDimensionResponse_type' - The type of the dimension.
--
-- 'httpStatus', 'updateDimensionResponse_httpStatus' - The response's http status code.
newUpdateDimensionResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  UpdateDimensionResponse
newUpdateDimensionResponse :: Int -> UpdateDimensionResponse
newUpdateDimensionResponse Int
pHttpStatus_ =
  UpdateDimensionResponse'
    { $sel:arn:UpdateDimensionResponse' :: Maybe Text
arn = forall a. Maybe a
Prelude.Nothing,
      $sel:creationDate:UpdateDimensionResponse' :: Maybe POSIX
creationDate = forall a. Maybe a
Prelude.Nothing,
      $sel:lastModifiedDate:UpdateDimensionResponse' :: Maybe POSIX
lastModifiedDate = forall a. Maybe a
Prelude.Nothing,
      $sel:name:UpdateDimensionResponse' :: Maybe Text
name = forall a. Maybe a
Prelude.Nothing,
      $sel:stringValues:UpdateDimensionResponse' :: Maybe (NonEmpty Text)
stringValues = forall a. Maybe a
Prelude.Nothing,
      $sel:type':UpdateDimensionResponse' :: Maybe DimensionType
type' = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:UpdateDimensionResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | The Amazon Resource Name (ARN)of the created dimension.
updateDimensionResponse_arn :: Lens.Lens' UpdateDimensionResponse (Prelude.Maybe Prelude.Text)
updateDimensionResponse_arn :: Lens' UpdateDimensionResponse (Maybe Text)
updateDimensionResponse_arn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateDimensionResponse' {Maybe Text
arn :: Maybe Text
$sel:arn:UpdateDimensionResponse' :: UpdateDimensionResponse -> Maybe Text
arn} -> Maybe Text
arn) (\s :: UpdateDimensionResponse
s@UpdateDimensionResponse' {} Maybe Text
a -> UpdateDimensionResponse
s {$sel:arn:UpdateDimensionResponse' :: Maybe Text
arn = Maybe Text
a} :: UpdateDimensionResponse)

-- | The date and time, in milliseconds since epoch, when the dimension was
-- initially created.
updateDimensionResponse_creationDate :: Lens.Lens' UpdateDimensionResponse (Prelude.Maybe Prelude.UTCTime)
updateDimensionResponse_creationDate :: Lens' UpdateDimensionResponse (Maybe UTCTime)
updateDimensionResponse_creationDate = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateDimensionResponse' {Maybe POSIX
creationDate :: Maybe POSIX
$sel:creationDate:UpdateDimensionResponse' :: UpdateDimensionResponse -> Maybe POSIX
creationDate} -> Maybe POSIX
creationDate) (\s :: UpdateDimensionResponse
s@UpdateDimensionResponse' {} Maybe POSIX
a -> UpdateDimensionResponse
s {$sel:creationDate:UpdateDimensionResponse' :: Maybe POSIX
creationDate = Maybe POSIX
a} :: UpdateDimensionResponse) 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 (a :: Format). Iso' (Time a) UTCTime
Data._Time

-- | The date and time, in milliseconds since epoch, when the dimension was
-- most recently updated.
updateDimensionResponse_lastModifiedDate :: Lens.Lens' UpdateDimensionResponse (Prelude.Maybe Prelude.UTCTime)
updateDimensionResponse_lastModifiedDate :: Lens' UpdateDimensionResponse (Maybe UTCTime)
updateDimensionResponse_lastModifiedDate = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateDimensionResponse' {Maybe POSIX
lastModifiedDate :: Maybe POSIX
$sel:lastModifiedDate:UpdateDimensionResponse' :: UpdateDimensionResponse -> Maybe POSIX
lastModifiedDate} -> Maybe POSIX
lastModifiedDate) (\s :: UpdateDimensionResponse
s@UpdateDimensionResponse' {} Maybe POSIX
a -> UpdateDimensionResponse
s {$sel:lastModifiedDate:UpdateDimensionResponse' :: Maybe POSIX
lastModifiedDate = Maybe POSIX
a} :: UpdateDimensionResponse) 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 (a :: Format). Iso' (Time a) UTCTime
Data._Time

-- | A unique identifier for the dimension.
updateDimensionResponse_name :: Lens.Lens' UpdateDimensionResponse (Prelude.Maybe Prelude.Text)
updateDimensionResponse_name :: Lens' UpdateDimensionResponse (Maybe Text)
updateDimensionResponse_name = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateDimensionResponse' {Maybe Text
name :: Maybe Text
$sel:name:UpdateDimensionResponse' :: UpdateDimensionResponse -> Maybe Text
name} -> Maybe Text
name) (\s :: UpdateDimensionResponse
s@UpdateDimensionResponse' {} Maybe Text
a -> UpdateDimensionResponse
s {$sel:name:UpdateDimensionResponse' :: Maybe Text
name = Maybe Text
a} :: UpdateDimensionResponse)

-- | The value or list of values used to scope the dimension. For example,
-- for topic filters, this is the pattern used to match the MQTT topic
-- name.
updateDimensionResponse_stringValues :: Lens.Lens' UpdateDimensionResponse (Prelude.Maybe (Prelude.NonEmpty Prelude.Text))
updateDimensionResponse_stringValues :: Lens' UpdateDimensionResponse (Maybe (NonEmpty Text))
updateDimensionResponse_stringValues = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateDimensionResponse' {Maybe (NonEmpty Text)
stringValues :: Maybe (NonEmpty Text)
$sel:stringValues:UpdateDimensionResponse' :: UpdateDimensionResponse -> Maybe (NonEmpty Text)
stringValues} -> Maybe (NonEmpty Text)
stringValues) (\s :: UpdateDimensionResponse
s@UpdateDimensionResponse' {} Maybe (NonEmpty Text)
a -> UpdateDimensionResponse
s {$sel:stringValues:UpdateDimensionResponse' :: Maybe (NonEmpty Text)
stringValues = Maybe (NonEmpty Text)
a} :: UpdateDimensionResponse) 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 type of the dimension.
updateDimensionResponse_type :: Lens.Lens' UpdateDimensionResponse (Prelude.Maybe DimensionType)
updateDimensionResponse_type :: Lens' UpdateDimensionResponse (Maybe DimensionType)
updateDimensionResponse_type = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateDimensionResponse' {Maybe DimensionType
type' :: Maybe DimensionType
$sel:type':UpdateDimensionResponse' :: UpdateDimensionResponse -> Maybe DimensionType
type'} -> Maybe DimensionType
type') (\s :: UpdateDimensionResponse
s@UpdateDimensionResponse' {} Maybe DimensionType
a -> UpdateDimensionResponse
s {$sel:type':UpdateDimensionResponse' :: Maybe DimensionType
type' = Maybe DimensionType
a} :: UpdateDimensionResponse)

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

instance Prelude.NFData UpdateDimensionResponse where
  rnf :: UpdateDimensionResponse -> ()
rnf UpdateDimensionResponse' {Int
Maybe (NonEmpty Text)
Maybe Text
Maybe POSIX
Maybe DimensionType
httpStatus :: Int
type' :: Maybe DimensionType
stringValues :: Maybe (NonEmpty Text)
name :: Maybe Text
lastModifiedDate :: Maybe POSIX
creationDate :: Maybe POSIX
arn :: Maybe Text
$sel:httpStatus:UpdateDimensionResponse' :: UpdateDimensionResponse -> Int
$sel:type':UpdateDimensionResponse' :: UpdateDimensionResponse -> Maybe DimensionType
$sel:stringValues:UpdateDimensionResponse' :: UpdateDimensionResponse -> Maybe (NonEmpty Text)
$sel:name:UpdateDimensionResponse' :: UpdateDimensionResponse -> Maybe Text
$sel:lastModifiedDate:UpdateDimensionResponse' :: UpdateDimensionResponse -> Maybe POSIX
$sel:creationDate:UpdateDimensionResponse' :: UpdateDimensionResponse -> Maybe POSIX
$sel:arn:UpdateDimensionResponse' :: UpdateDimensionResponse -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
arn
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe POSIX
creationDate
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe POSIX
lastModifiedDate
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
name
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe (NonEmpty Text)
stringValues
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe DimensionType
type'
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus