{-# 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.CreateCustomMetric
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Use this API to define a Custom Metric published by your devices to
-- Device Defender.
--
-- Requires permission to access the
-- <https://docs.aws.amazon.com/service-authorization/latest/reference/list_awsiot.html#awsiot-actions-as-permissions CreateCustomMetric>
-- action.
module Amazonka.IoT.CreateCustomMetric
  ( -- * Creating a Request
    CreateCustomMetric (..),
    newCreateCustomMetric,

    -- * Request Lenses
    createCustomMetric_displayName,
    createCustomMetric_tags,
    createCustomMetric_metricName,
    createCustomMetric_metricType,
    createCustomMetric_clientRequestToken,

    -- * Destructuring the Response
    CreateCustomMetricResponse (..),
    newCreateCustomMetricResponse,

    -- * Response Lenses
    createCustomMetricResponse_metricArn,
    createCustomMetricResponse_metricName,
    createCustomMetricResponse_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:/ 'newCreateCustomMetric' smart constructor.
data CreateCustomMetric = CreateCustomMetric'
  { -- | The friendly name in the console for the custom metric. This name
    -- doesn\'t have to be unique. Don\'t use this name as the metric
    -- identifier in the device metric report. You can update the friendly name
    -- after you define it.
    CreateCustomMetric -> Maybe Text
displayName :: Prelude.Maybe Prelude.Text,
    -- | Metadata that can be used to manage the custom metric.
    CreateCustomMetric -> Maybe [Tag]
tags :: Prelude.Maybe [Tag],
    -- | The name of the custom metric. This will be used in the metric report
    -- submitted from the device\/thing. The name can\'t begin with @aws:@. You
    -- can\'t change the name after you define it.
    CreateCustomMetric -> Text
metricName :: Prelude.Text,
    -- | The type of the custom metric.
    --
    -- The type @number@ only takes a single metric value as an input, but when
    -- you submit the metrics value in the DeviceMetrics report, you must pass
    -- it as an array with a single value.
    CreateCustomMetric -> CustomMetricType
metricType :: CustomMetricType,
    -- | Each custom metric must have a unique client request token. If you try
    -- to create a new custom metric that already exists with a different
    -- token, an exception occurs. If you omit this value, Amazon Web Services
    -- SDKs will automatically generate a unique client request.
    CreateCustomMetric -> Text
clientRequestToken :: Prelude.Text
  }
  deriving (CreateCustomMetric -> CreateCustomMetric -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateCustomMetric -> CreateCustomMetric -> Bool
$c/= :: CreateCustomMetric -> CreateCustomMetric -> Bool
== :: CreateCustomMetric -> CreateCustomMetric -> Bool
$c== :: CreateCustomMetric -> CreateCustomMetric -> Bool
Prelude.Eq, ReadPrec [CreateCustomMetric]
ReadPrec CreateCustomMetric
Int -> ReadS CreateCustomMetric
ReadS [CreateCustomMetric]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CreateCustomMetric]
$creadListPrec :: ReadPrec [CreateCustomMetric]
readPrec :: ReadPrec CreateCustomMetric
$creadPrec :: ReadPrec CreateCustomMetric
readList :: ReadS [CreateCustomMetric]
$creadList :: ReadS [CreateCustomMetric]
readsPrec :: Int -> ReadS CreateCustomMetric
$creadsPrec :: Int -> ReadS CreateCustomMetric
Prelude.Read, Int -> CreateCustomMetric -> ShowS
[CreateCustomMetric] -> ShowS
CreateCustomMetric -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateCustomMetric] -> ShowS
$cshowList :: [CreateCustomMetric] -> ShowS
show :: CreateCustomMetric -> String
$cshow :: CreateCustomMetric -> String
showsPrec :: Int -> CreateCustomMetric -> ShowS
$cshowsPrec :: Int -> CreateCustomMetric -> ShowS
Prelude.Show, forall x. Rep CreateCustomMetric x -> CreateCustomMetric
forall x. CreateCustomMetric -> Rep CreateCustomMetric x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CreateCustomMetric x -> CreateCustomMetric
$cfrom :: forall x. CreateCustomMetric -> Rep CreateCustomMetric x
Prelude.Generic)

-- |
-- Create a value of 'CreateCustomMetric' 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:
--
-- 'displayName', 'createCustomMetric_displayName' - The friendly name in the console for the custom metric. This name
-- doesn\'t have to be unique. Don\'t use this name as the metric
-- identifier in the device metric report. You can update the friendly name
-- after you define it.
--
-- 'tags', 'createCustomMetric_tags' - Metadata that can be used to manage the custom metric.
--
-- 'metricName', 'createCustomMetric_metricName' - The name of the custom metric. This will be used in the metric report
-- submitted from the device\/thing. The name can\'t begin with @aws:@. You
-- can\'t change the name after you define it.
--
-- 'metricType', 'createCustomMetric_metricType' - The type of the custom metric.
--
-- The type @number@ only takes a single metric value as an input, but when
-- you submit the metrics value in the DeviceMetrics report, you must pass
-- it as an array with a single value.
--
-- 'clientRequestToken', 'createCustomMetric_clientRequestToken' - Each custom metric must have a unique client request token. If you try
-- to create a new custom metric that already exists with a different
-- token, an exception occurs. If you omit this value, Amazon Web Services
-- SDKs will automatically generate a unique client request.
newCreateCustomMetric ::
  -- | 'metricName'
  Prelude.Text ->
  -- | 'metricType'
  CustomMetricType ->
  -- | 'clientRequestToken'
  Prelude.Text ->
  CreateCustomMetric
newCreateCustomMetric :: Text -> CustomMetricType -> Text -> CreateCustomMetric
newCreateCustomMetric
  Text
pMetricName_
  CustomMetricType
pMetricType_
  Text
pClientRequestToken_ =
    CreateCustomMetric'
      { $sel:displayName:CreateCustomMetric' :: Maybe Text
displayName = forall a. Maybe a
Prelude.Nothing,
        $sel:tags:CreateCustomMetric' :: Maybe [Tag]
tags = forall a. Maybe a
Prelude.Nothing,
        $sel:metricName:CreateCustomMetric' :: Text
metricName = Text
pMetricName_,
        $sel:metricType:CreateCustomMetric' :: CustomMetricType
metricType = CustomMetricType
pMetricType_,
        $sel:clientRequestToken:CreateCustomMetric' :: Text
clientRequestToken = Text
pClientRequestToken_
      }

-- | The friendly name in the console for the custom metric. This name
-- doesn\'t have to be unique. Don\'t use this name as the metric
-- identifier in the device metric report. You can update the friendly name
-- after you define it.
createCustomMetric_displayName :: Lens.Lens' CreateCustomMetric (Prelude.Maybe Prelude.Text)
createCustomMetric_displayName :: Lens' CreateCustomMetric (Maybe Text)
createCustomMetric_displayName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateCustomMetric' {Maybe Text
displayName :: Maybe Text
$sel:displayName:CreateCustomMetric' :: CreateCustomMetric -> Maybe Text
displayName} -> Maybe Text
displayName) (\s :: CreateCustomMetric
s@CreateCustomMetric' {} Maybe Text
a -> CreateCustomMetric
s {$sel:displayName:CreateCustomMetric' :: Maybe Text
displayName = Maybe Text
a} :: CreateCustomMetric)

-- | Metadata that can be used to manage the custom metric.
createCustomMetric_tags :: Lens.Lens' CreateCustomMetric (Prelude.Maybe [Tag])
createCustomMetric_tags :: Lens' CreateCustomMetric (Maybe [Tag])
createCustomMetric_tags = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateCustomMetric' {Maybe [Tag]
tags :: Maybe [Tag]
$sel:tags:CreateCustomMetric' :: CreateCustomMetric -> Maybe [Tag]
tags} -> Maybe [Tag]
tags) (\s :: CreateCustomMetric
s@CreateCustomMetric' {} Maybe [Tag]
a -> CreateCustomMetric
s {$sel:tags:CreateCustomMetric' :: Maybe [Tag]
tags = Maybe [Tag]
a} :: CreateCustomMetric) 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 name of the custom metric. This will be used in the metric report
-- submitted from the device\/thing. The name can\'t begin with @aws:@. You
-- can\'t change the name after you define it.
createCustomMetric_metricName :: Lens.Lens' CreateCustomMetric Prelude.Text
createCustomMetric_metricName :: Lens' CreateCustomMetric Text
createCustomMetric_metricName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateCustomMetric' {Text
metricName :: Text
$sel:metricName:CreateCustomMetric' :: CreateCustomMetric -> Text
metricName} -> Text
metricName) (\s :: CreateCustomMetric
s@CreateCustomMetric' {} Text
a -> CreateCustomMetric
s {$sel:metricName:CreateCustomMetric' :: Text
metricName = Text
a} :: CreateCustomMetric)

-- | The type of the custom metric.
--
-- The type @number@ only takes a single metric value as an input, but when
-- you submit the metrics value in the DeviceMetrics report, you must pass
-- it as an array with a single value.
createCustomMetric_metricType :: Lens.Lens' CreateCustomMetric CustomMetricType
createCustomMetric_metricType :: Lens' CreateCustomMetric CustomMetricType
createCustomMetric_metricType = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateCustomMetric' {CustomMetricType
metricType :: CustomMetricType
$sel:metricType:CreateCustomMetric' :: CreateCustomMetric -> CustomMetricType
metricType} -> CustomMetricType
metricType) (\s :: CreateCustomMetric
s@CreateCustomMetric' {} CustomMetricType
a -> CreateCustomMetric
s {$sel:metricType:CreateCustomMetric' :: CustomMetricType
metricType = CustomMetricType
a} :: CreateCustomMetric)

-- | Each custom metric must have a unique client request token. If you try
-- to create a new custom metric that already exists with a different
-- token, an exception occurs. If you omit this value, Amazon Web Services
-- SDKs will automatically generate a unique client request.
createCustomMetric_clientRequestToken :: Lens.Lens' CreateCustomMetric Prelude.Text
createCustomMetric_clientRequestToken :: Lens' CreateCustomMetric Text
createCustomMetric_clientRequestToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateCustomMetric' {Text
clientRequestToken :: Text
$sel:clientRequestToken:CreateCustomMetric' :: CreateCustomMetric -> Text
clientRequestToken} -> Text
clientRequestToken) (\s :: CreateCustomMetric
s@CreateCustomMetric' {} Text
a -> CreateCustomMetric
s {$sel:clientRequestToken:CreateCustomMetric' :: Text
clientRequestToken = Text
a} :: CreateCustomMetric)

instance Core.AWSRequest CreateCustomMetric where
  type
    AWSResponse CreateCustomMetric =
      CreateCustomMetricResponse
  request :: (Service -> Service)
-> CreateCustomMetric -> Request CreateCustomMetric
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 CreateCustomMetric
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse CreateCustomMetric)))
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 -> CreateCustomMetricResponse
CreateCustomMetricResponse'
            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
"metricArn")
            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
"metricName")
            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 CreateCustomMetric where
  hashWithSalt :: Int -> CreateCustomMetric -> Int
hashWithSalt Int
_salt CreateCustomMetric' {Maybe [Tag]
Maybe Text
Text
CustomMetricType
clientRequestToken :: Text
metricType :: CustomMetricType
metricName :: Text
tags :: Maybe [Tag]
displayName :: Maybe Text
$sel:clientRequestToken:CreateCustomMetric' :: CreateCustomMetric -> Text
$sel:metricType:CreateCustomMetric' :: CreateCustomMetric -> CustomMetricType
$sel:metricName:CreateCustomMetric' :: CreateCustomMetric -> Text
$sel:tags:CreateCustomMetric' :: CreateCustomMetric -> Maybe [Tag]
$sel:displayName:CreateCustomMetric' :: CreateCustomMetric -> Maybe Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
displayName
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [Tag]
tags
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
metricName
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` CustomMetricType
metricType
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
clientRequestToken

instance Prelude.NFData CreateCustomMetric where
  rnf :: CreateCustomMetric -> ()
rnf CreateCustomMetric' {Maybe [Tag]
Maybe Text
Text
CustomMetricType
clientRequestToken :: Text
metricType :: CustomMetricType
metricName :: Text
tags :: Maybe [Tag]
displayName :: Maybe Text
$sel:clientRequestToken:CreateCustomMetric' :: CreateCustomMetric -> Text
$sel:metricType:CreateCustomMetric' :: CreateCustomMetric -> CustomMetricType
$sel:metricName:CreateCustomMetric' :: CreateCustomMetric -> Text
$sel:tags:CreateCustomMetric' :: CreateCustomMetric -> Maybe [Tag]
$sel:displayName:CreateCustomMetric' :: CreateCustomMetric -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
displayName
      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
metricName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf CustomMetricType
metricType
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
clientRequestToken

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

instance Data.ToJSON CreateCustomMetric where
  toJSON :: CreateCustomMetric -> Value
toJSON CreateCustomMetric' {Maybe [Tag]
Maybe Text
Text
CustomMetricType
clientRequestToken :: Text
metricType :: CustomMetricType
metricName :: Text
tags :: Maybe [Tag]
displayName :: Maybe Text
$sel:clientRequestToken:CreateCustomMetric' :: CreateCustomMetric -> Text
$sel:metricType:CreateCustomMetric' :: CreateCustomMetric -> CustomMetricType
$sel:metricName:CreateCustomMetric' :: CreateCustomMetric -> Text
$sel:tags:CreateCustomMetric' :: CreateCustomMetric -> Maybe [Tag]
$sel:displayName:CreateCustomMetric' :: CreateCustomMetric -> Maybe Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"displayName" 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
displayName,
            (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
"metricType" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= CustomMetricType
metricType),
            forall a. a -> Maybe a
Prelude.Just
              (Key
"clientRequestToken" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
clientRequestToken)
          ]
      )

instance Data.ToPath CreateCustomMetric where
  toPath :: CreateCustomMetric -> ByteString
toPath CreateCustomMetric' {Maybe [Tag]
Maybe Text
Text
CustomMetricType
clientRequestToken :: Text
metricType :: CustomMetricType
metricName :: Text
tags :: Maybe [Tag]
displayName :: Maybe Text
$sel:clientRequestToken:CreateCustomMetric' :: CreateCustomMetric -> Text
$sel:metricType:CreateCustomMetric' :: CreateCustomMetric -> CustomMetricType
$sel:metricName:CreateCustomMetric' :: CreateCustomMetric -> Text
$sel:tags:CreateCustomMetric' :: CreateCustomMetric -> Maybe [Tag]
$sel:displayName:CreateCustomMetric' :: CreateCustomMetric -> Maybe Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ByteString
"/custom-metric/", forall a. ToByteString a => a -> ByteString
Data.toBS Text
metricName]

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

-- | /See:/ 'newCreateCustomMetricResponse' smart constructor.
data CreateCustomMetricResponse = CreateCustomMetricResponse'
  { -- | The Amazon Resource Number (ARN) of the custom metric. For example,
    -- @arn:@/@aws-partition@/@:iot:@/@region@/@:@/@accountId@/@:custommetric\/@/@metricName@/@ @
    CreateCustomMetricResponse -> Maybe Text
metricArn :: Prelude.Maybe Prelude.Text,
    -- | The name of the custom metric to be used in the metric report.
    CreateCustomMetricResponse -> Maybe Text
metricName :: Prelude.Maybe Prelude.Text,
    -- | The response's http status code.
    CreateCustomMetricResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (CreateCustomMetricResponse -> CreateCustomMetricResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateCustomMetricResponse -> CreateCustomMetricResponse -> Bool
$c/= :: CreateCustomMetricResponse -> CreateCustomMetricResponse -> Bool
== :: CreateCustomMetricResponse -> CreateCustomMetricResponse -> Bool
$c== :: CreateCustomMetricResponse -> CreateCustomMetricResponse -> Bool
Prelude.Eq, ReadPrec [CreateCustomMetricResponse]
ReadPrec CreateCustomMetricResponse
Int -> ReadS CreateCustomMetricResponse
ReadS [CreateCustomMetricResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CreateCustomMetricResponse]
$creadListPrec :: ReadPrec [CreateCustomMetricResponse]
readPrec :: ReadPrec CreateCustomMetricResponse
$creadPrec :: ReadPrec CreateCustomMetricResponse
readList :: ReadS [CreateCustomMetricResponse]
$creadList :: ReadS [CreateCustomMetricResponse]
readsPrec :: Int -> ReadS CreateCustomMetricResponse
$creadsPrec :: Int -> ReadS CreateCustomMetricResponse
Prelude.Read, Int -> CreateCustomMetricResponse -> ShowS
[CreateCustomMetricResponse] -> ShowS
CreateCustomMetricResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateCustomMetricResponse] -> ShowS
$cshowList :: [CreateCustomMetricResponse] -> ShowS
show :: CreateCustomMetricResponse -> String
$cshow :: CreateCustomMetricResponse -> String
showsPrec :: Int -> CreateCustomMetricResponse -> ShowS
$cshowsPrec :: Int -> CreateCustomMetricResponse -> ShowS
Prelude.Show, forall x.
Rep CreateCustomMetricResponse x -> CreateCustomMetricResponse
forall x.
CreateCustomMetricResponse -> Rep CreateCustomMetricResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep CreateCustomMetricResponse x -> CreateCustomMetricResponse
$cfrom :: forall x.
CreateCustomMetricResponse -> Rep CreateCustomMetricResponse x
Prelude.Generic)

-- |
-- Create a value of 'CreateCustomMetricResponse' 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:
--
-- 'metricArn', 'createCustomMetricResponse_metricArn' - The Amazon Resource Number (ARN) of the custom metric. For example,
-- @arn:@/@aws-partition@/@:iot:@/@region@/@:@/@accountId@/@:custommetric\/@/@metricName@/@ @
--
-- 'metricName', 'createCustomMetricResponse_metricName' - The name of the custom metric to be used in the metric report.
--
-- 'httpStatus', 'createCustomMetricResponse_httpStatus' - The response's http status code.
newCreateCustomMetricResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  CreateCustomMetricResponse
newCreateCustomMetricResponse :: Int -> CreateCustomMetricResponse
newCreateCustomMetricResponse Int
pHttpStatus_ =
  CreateCustomMetricResponse'
    { $sel:metricArn:CreateCustomMetricResponse' :: Maybe Text
metricArn =
        forall a. Maybe a
Prelude.Nothing,
      $sel:metricName:CreateCustomMetricResponse' :: Maybe Text
metricName = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:CreateCustomMetricResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | The Amazon Resource Number (ARN) of the custom metric. For example,
-- @arn:@/@aws-partition@/@:iot:@/@region@/@:@/@accountId@/@:custommetric\/@/@metricName@/@ @
createCustomMetricResponse_metricArn :: Lens.Lens' CreateCustomMetricResponse (Prelude.Maybe Prelude.Text)
createCustomMetricResponse_metricArn :: Lens' CreateCustomMetricResponse (Maybe Text)
createCustomMetricResponse_metricArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateCustomMetricResponse' {Maybe Text
metricArn :: Maybe Text
$sel:metricArn:CreateCustomMetricResponse' :: CreateCustomMetricResponse -> Maybe Text
metricArn} -> Maybe Text
metricArn) (\s :: CreateCustomMetricResponse
s@CreateCustomMetricResponse' {} Maybe Text
a -> CreateCustomMetricResponse
s {$sel:metricArn:CreateCustomMetricResponse' :: Maybe Text
metricArn = Maybe Text
a} :: CreateCustomMetricResponse)

-- | The name of the custom metric to be used in the metric report.
createCustomMetricResponse_metricName :: Lens.Lens' CreateCustomMetricResponse (Prelude.Maybe Prelude.Text)
createCustomMetricResponse_metricName :: Lens' CreateCustomMetricResponse (Maybe Text)
createCustomMetricResponse_metricName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateCustomMetricResponse' {Maybe Text
metricName :: Maybe Text
$sel:metricName:CreateCustomMetricResponse' :: CreateCustomMetricResponse -> Maybe Text
metricName} -> Maybe Text
metricName) (\s :: CreateCustomMetricResponse
s@CreateCustomMetricResponse' {} Maybe Text
a -> CreateCustomMetricResponse
s {$sel:metricName:CreateCustomMetricResponse' :: Maybe Text
metricName = Maybe Text
a} :: CreateCustomMetricResponse)

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

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