{-# 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.EC2.EnableAwsNetworkPerformanceMetricSubscription
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Enables Infrastructure Performance subscriptions.
module Amazonka.EC2.EnableAwsNetworkPerformanceMetricSubscription
  ( -- * Creating a Request
    EnableAwsNetworkPerformanceMetricSubscription (..),
    newEnableAwsNetworkPerformanceMetricSubscription,

    -- * Request Lenses
    enableAwsNetworkPerformanceMetricSubscription_destination,
    enableAwsNetworkPerformanceMetricSubscription_dryRun,
    enableAwsNetworkPerformanceMetricSubscription_metric,
    enableAwsNetworkPerformanceMetricSubscription_source,
    enableAwsNetworkPerformanceMetricSubscription_statistic,

    -- * Destructuring the Response
    EnableAwsNetworkPerformanceMetricSubscriptionResponse (..),
    newEnableAwsNetworkPerformanceMetricSubscriptionResponse,

    -- * Response Lenses
    enableAwsNetworkPerformanceMetricSubscriptionResponse_output,
    enableAwsNetworkPerformanceMetricSubscriptionResponse_httpStatus,
  )
where

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

-- | /See:/ 'newEnableAwsNetworkPerformanceMetricSubscription' smart constructor.
data EnableAwsNetworkPerformanceMetricSubscription = EnableAwsNetworkPerformanceMetricSubscription'
  { -- | The target Region or Availability Zone that the metric subscription is
    -- enabled for. For example, @eu-west-1@.
    EnableAwsNetworkPerformanceMetricSubscription -> Maybe Text
destination :: Prelude.Maybe Prelude.Text,
    -- | Checks whether you have the required permissions for the action, without
    -- actually making the request, and provides an error response. If you have
    -- the required permissions, the error response is @DryRunOperation@.
    -- Otherwise, it is @UnauthorizedOperation@.
    EnableAwsNetworkPerformanceMetricSubscription -> Maybe Bool
dryRun :: Prelude.Maybe Prelude.Bool,
    -- | The metric used for the enabled subscription.
    EnableAwsNetworkPerformanceMetricSubscription -> Maybe MetricType
metric :: Prelude.Maybe MetricType,
    -- | The source Region or Availability Zone that the metric subscription is
    -- enabled for. For example, @us-east-1@.
    EnableAwsNetworkPerformanceMetricSubscription -> Maybe Text
source :: Prelude.Maybe Prelude.Text,
    -- | The statistic used for the enabled subscription.
    EnableAwsNetworkPerformanceMetricSubscription
-> Maybe StatisticType
statistic :: Prelude.Maybe StatisticType
  }
  deriving (EnableAwsNetworkPerformanceMetricSubscription
-> EnableAwsNetworkPerformanceMetricSubscription -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: EnableAwsNetworkPerformanceMetricSubscription
-> EnableAwsNetworkPerformanceMetricSubscription -> Bool
$c/= :: EnableAwsNetworkPerformanceMetricSubscription
-> EnableAwsNetworkPerformanceMetricSubscription -> Bool
== :: EnableAwsNetworkPerformanceMetricSubscription
-> EnableAwsNetworkPerformanceMetricSubscription -> Bool
$c== :: EnableAwsNetworkPerformanceMetricSubscription
-> EnableAwsNetworkPerformanceMetricSubscription -> Bool
Prelude.Eq, ReadPrec [EnableAwsNetworkPerformanceMetricSubscription]
ReadPrec EnableAwsNetworkPerformanceMetricSubscription
Int -> ReadS EnableAwsNetworkPerformanceMetricSubscription
ReadS [EnableAwsNetworkPerformanceMetricSubscription]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [EnableAwsNetworkPerformanceMetricSubscription]
$creadListPrec :: ReadPrec [EnableAwsNetworkPerformanceMetricSubscription]
readPrec :: ReadPrec EnableAwsNetworkPerformanceMetricSubscription
$creadPrec :: ReadPrec EnableAwsNetworkPerformanceMetricSubscription
readList :: ReadS [EnableAwsNetworkPerformanceMetricSubscription]
$creadList :: ReadS [EnableAwsNetworkPerformanceMetricSubscription]
readsPrec :: Int -> ReadS EnableAwsNetworkPerformanceMetricSubscription
$creadsPrec :: Int -> ReadS EnableAwsNetworkPerformanceMetricSubscription
Prelude.Read, Int -> EnableAwsNetworkPerformanceMetricSubscription -> ShowS
[EnableAwsNetworkPerformanceMetricSubscription] -> ShowS
EnableAwsNetworkPerformanceMetricSubscription -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [EnableAwsNetworkPerformanceMetricSubscription] -> ShowS
$cshowList :: [EnableAwsNetworkPerformanceMetricSubscription] -> ShowS
show :: EnableAwsNetworkPerformanceMetricSubscription -> String
$cshow :: EnableAwsNetworkPerformanceMetricSubscription -> String
showsPrec :: Int -> EnableAwsNetworkPerformanceMetricSubscription -> ShowS
$cshowsPrec :: Int -> EnableAwsNetworkPerformanceMetricSubscription -> ShowS
Prelude.Show, forall x.
Rep EnableAwsNetworkPerformanceMetricSubscription x
-> EnableAwsNetworkPerformanceMetricSubscription
forall x.
EnableAwsNetworkPerformanceMetricSubscription
-> Rep EnableAwsNetworkPerformanceMetricSubscription x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep EnableAwsNetworkPerformanceMetricSubscription x
-> EnableAwsNetworkPerformanceMetricSubscription
$cfrom :: forall x.
EnableAwsNetworkPerformanceMetricSubscription
-> Rep EnableAwsNetworkPerformanceMetricSubscription x
Prelude.Generic)

-- |
-- Create a value of 'EnableAwsNetworkPerformanceMetricSubscription' 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:
--
-- 'destination', 'enableAwsNetworkPerformanceMetricSubscription_destination' - The target Region or Availability Zone that the metric subscription is
-- enabled for. For example, @eu-west-1@.
--
-- 'dryRun', 'enableAwsNetworkPerformanceMetricSubscription_dryRun' - Checks whether you have the required permissions for the action, without
-- actually making the request, and provides an error response. If you have
-- the required permissions, the error response is @DryRunOperation@.
-- Otherwise, it is @UnauthorizedOperation@.
--
-- 'metric', 'enableAwsNetworkPerformanceMetricSubscription_metric' - The metric used for the enabled subscription.
--
-- 'source', 'enableAwsNetworkPerformanceMetricSubscription_source' - The source Region or Availability Zone that the metric subscription is
-- enabled for. For example, @us-east-1@.
--
-- 'statistic', 'enableAwsNetworkPerformanceMetricSubscription_statistic' - The statistic used for the enabled subscription.
newEnableAwsNetworkPerformanceMetricSubscription ::
  EnableAwsNetworkPerformanceMetricSubscription
newEnableAwsNetworkPerformanceMetricSubscription :: EnableAwsNetworkPerformanceMetricSubscription
newEnableAwsNetworkPerformanceMetricSubscription =
  EnableAwsNetworkPerformanceMetricSubscription'
    { $sel:destination:EnableAwsNetworkPerformanceMetricSubscription' :: Maybe Text
destination =
        forall a. Maybe a
Prelude.Nothing,
      $sel:dryRun:EnableAwsNetworkPerformanceMetricSubscription' :: Maybe Bool
dryRun = forall a. Maybe a
Prelude.Nothing,
      $sel:metric:EnableAwsNetworkPerformanceMetricSubscription' :: Maybe MetricType
metric = forall a. Maybe a
Prelude.Nothing,
      $sel:source:EnableAwsNetworkPerformanceMetricSubscription' :: Maybe Text
source = forall a. Maybe a
Prelude.Nothing,
      $sel:statistic:EnableAwsNetworkPerformanceMetricSubscription' :: Maybe StatisticType
statistic = forall a. Maybe a
Prelude.Nothing
    }

-- | The target Region or Availability Zone that the metric subscription is
-- enabled for. For example, @eu-west-1@.
enableAwsNetworkPerformanceMetricSubscription_destination :: Lens.Lens' EnableAwsNetworkPerformanceMetricSubscription (Prelude.Maybe Prelude.Text)
enableAwsNetworkPerformanceMetricSubscription_destination :: Lens' EnableAwsNetworkPerformanceMetricSubscription (Maybe Text)
enableAwsNetworkPerformanceMetricSubscription_destination = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\EnableAwsNetworkPerformanceMetricSubscription' {Maybe Text
destination :: Maybe Text
$sel:destination:EnableAwsNetworkPerformanceMetricSubscription' :: EnableAwsNetworkPerformanceMetricSubscription -> Maybe Text
destination} -> Maybe Text
destination) (\s :: EnableAwsNetworkPerformanceMetricSubscription
s@EnableAwsNetworkPerformanceMetricSubscription' {} Maybe Text
a -> EnableAwsNetworkPerformanceMetricSubscription
s {$sel:destination:EnableAwsNetworkPerformanceMetricSubscription' :: Maybe Text
destination = Maybe Text
a} :: EnableAwsNetworkPerformanceMetricSubscription)

-- | Checks whether you have the required permissions for the action, without
-- actually making the request, and provides an error response. If you have
-- the required permissions, the error response is @DryRunOperation@.
-- Otherwise, it is @UnauthorizedOperation@.
enableAwsNetworkPerformanceMetricSubscription_dryRun :: Lens.Lens' EnableAwsNetworkPerformanceMetricSubscription (Prelude.Maybe Prelude.Bool)
enableAwsNetworkPerformanceMetricSubscription_dryRun :: Lens' EnableAwsNetworkPerformanceMetricSubscription (Maybe Bool)
enableAwsNetworkPerformanceMetricSubscription_dryRun = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\EnableAwsNetworkPerformanceMetricSubscription' {Maybe Bool
dryRun :: Maybe Bool
$sel:dryRun:EnableAwsNetworkPerformanceMetricSubscription' :: EnableAwsNetworkPerformanceMetricSubscription -> Maybe Bool
dryRun} -> Maybe Bool
dryRun) (\s :: EnableAwsNetworkPerformanceMetricSubscription
s@EnableAwsNetworkPerformanceMetricSubscription' {} Maybe Bool
a -> EnableAwsNetworkPerformanceMetricSubscription
s {$sel:dryRun:EnableAwsNetworkPerformanceMetricSubscription' :: Maybe Bool
dryRun = Maybe Bool
a} :: EnableAwsNetworkPerformanceMetricSubscription)

-- | The metric used for the enabled subscription.
enableAwsNetworkPerformanceMetricSubscription_metric :: Lens.Lens' EnableAwsNetworkPerformanceMetricSubscription (Prelude.Maybe MetricType)
enableAwsNetworkPerformanceMetricSubscription_metric :: Lens'
  EnableAwsNetworkPerformanceMetricSubscription (Maybe MetricType)
enableAwsNetworkPerformanceMetricSubscription_metric = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\EnableAwsNetworkPerformanceMetricSubscription' {Maybe MetricType
metric :: Maybe MetricType
$sel:metric:EnableAwsNetworkPerformanceMetricSubscription' :: EnableAwsNetworkPerformanceMetricSubscription -> Maybe MetricType
metric} -> Maybe MetricType
metric) (\s :: EnableAwsNetworkPerformanceMetricSubscription
s@EnableAwsNetworkPerformanceMetricSubscription' {} Maybe MetricType
a -> EnableAwsNetworkPerformanceMetricSubscription
s {$sel:metric:EnableAwsNetworkPerformanceMetricSubscription' :: Maybe MetricType
metric = Maybe MetricType
a} :: EnableAwsNetworkPerformanceMetricSubscription)

-- | The source Region or Availability Zone that the metric subscription is
-- enabled for. For example, @us-east-1@.
enableAwsNetworkPerformanceMetricSubscription_source :: Lens.Lens' EnableAwsNetworkPerformanceMetricSubscription (Prelude.Maybe Prelude.Text)
enableAwsNetworkPerformanceMetricSubscription_source :: Lens' EnableAwsNetworkPerformanceMetricSubscription (Maybe Text)
enableAwsNetworkPerformanceMetricSubscription_source = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\EnableAwsNetworkPerformanceMetricSubscription' {Maybe Text
source :: Maybe Text
$sel:source:EnableAwsNetworkPerformanceMetricSubscription' :: EnableAwsNetworkPerformanceMetricSubscription -> Maybe Text
source} -> Maybe Text
source) (\s :: EnableAwsNetworkPerformanceMetricSubscription
s@EnableAwsNetworkPerformanceMetricSubscription' {} Maybe Text
a -> EnableAwsNetworkPerformanceMetricSubscription
s {$sel:source:EnableAwsNetworkPerformanceMetricSubscription' :: Maybe Text
source = Maybe Text
a} :: EnableAwsNetworkPerformanceMetricSubscription)

-- | The statistic used for the enabled subscription.
enableAwsNetworkPerformanceMetricSubscription_statistic :: Lens.Lens' EnableAwsNetworkPerformanceMetricSubscription (Prelude.Maybe StatisticType)
enableAwsNetworkPerformanceMetricSubscription_statistic :: Lens'
  EnableAwsNetworkPerformanceMetricSubscription (Maybe StatisticType)
enableAwsNetworkPerformanceMetricSubscription_statistic = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\EnableAwsNetworkPerformanceMetricSubscription' {Maybe StatisticType
statistic :: Maybe StatisticType
$sel:statistic:EnableAwsNetworkPerformanceMetricSubscription' :: EnableAwsNetworkPerformanceMetricSubscription
-> Maybe StatisticType
statistic} -> Maybe StatisticType
statistic) (\s :: EnableAwsNetworkPerformanceMetricSubscription
s@EnableAwsNetworkPerformanceMetricSubscription' {} Maybe StatisticType
a -> EnableAwsNetworkPerformanceMetricSubscription
s {$sel:statistic:EnableAwsNetworkPerformanceMetricSubscription' :: Maybe StatisticType
statistic = Maybe StatisticType
a} :: EnableAwsNetworkPerformanceMetricSubscription)

instance
  Core.AWSRequest
    EnableAwsNetworkPerformanceMetricSubscription
  where
  type
    AWSResponse
      EnableAwsNetworkPerformanceMetricSubscription =
      EnableAwsNetworkPerformanceMetricSubscriptionResponse
  request :: (Service -> Service)
-> EnableAwsNetworkPerformanceMetricSubscription
-> Request EnableAwsNetworkPerformanceMetricSubscription
request Service -> Service
overrides =
    forall a. ToRequest a => Service -> a -> Request a
Request.postQuery (Service -> Service
overrides Service
defaultService)
  response :: forall (m :: * -> *).
MonadResource m =>
(ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy EnableAwsNetworkPerformanceMetricSubscription
-> ClientResponse ClientBody
-> m (Either
        Error
        (ClientResponse
           (AWSResponse EnableAwsNetworkPerformanceMetricSubscription)))
response =
    forall (m :: * -> *) a.
MonadResource m =>
(Int -> ResponseHeaders -> [Node] -> Either String (AWSResponse a))
-> (ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy a
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse a)))
Response.receiveXML
      ( \Int
s ResponseHeaders
h [Node]
x ->
          Maybe Bool
-> Int -> EnableAwsNetworkPerformanceMetricSubscriptionResponse
EnableAwsNetworkPerformanceMetricSubscriptionResponse'
            forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> ([Node]
x forall a. FromXML a => [Node] -> Text -> Either String (Maybe a)
Data..@? Text
"output")
            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
    EnableAwsNetworkPerformanceMetricSubscription
  where
  hashWithSalt :: Int -> EnableAwsNetworkPerformanceMetricSubscription -> Int
hashWithSalt
    Int
_salt
    EnableAwsNetworkPerformanceMetricSubscription' {Maybe Bool
Maybe Text
Maybe MetricType
Maybe StatisticType
statistic :: Maybe StatisticType
source :: Maybe Text
metric :: Maybe MetricType
dryRun :: Maybe Bool
destination :: Maybe Text
$sel:statistic:EnableAwsNetworkPerformanceMetricSubscription' :: EnableAwsNetworkPerformanceMetricSubscription
-> Maybe StatisticType
$sel:source:EnableAwsNetworkPerformanceMetricSubscription' :: EnableAwsNetworkPerformanceMetricSubscription -> Maybe Text
$sel:metric:EnableAwsNetworkPerformanceMetricSubscription' :: EnableAwsNetworkPerformanceMetricSubscription -> Maybe MetricType
$sel:dryRun:EnableAwsNetworkPerformanceMetricSubscription' :: EnableAwsNetworkPerformanceMetricSubscription -> Maybe Bool
$sel:destination:EnableAwsNetworkPerformanceMetricSubscription' :: EnableAwsNetworkPerformanceMetricSubscription -> Maybe Text
..} =
      Int
_salt
        forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
destination
        forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Bool
dryRun
        forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe MetricType
metric
        forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
source
        forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe StatisticType
statistic

instance
  Prelude.NFData
    EnableAwsNetworkPerformanceMetricSubscription
  where
  rnf :: EnableAwsNetworkPerformanceMetricSubscription -> ()
rnf
    EnableAwsNetworkPerformanceMetricSubscription' {Maybe Bool
Maybe Text
Maybe MetricType
Maybe StatisticType
statistic :: Maybe StatisticType
source :: Maybe Text
metric :: Maybe MetricType
dryRun :: Maybe Bool
destination :: Maybe Text
$sel:statistic:EnableAwsNetworkPerformanceMetricSubscription' :: EnableAwsNetworkPerformanceMetricSubscription
-> Maybe StatisticType
$sel:source:EnableAwsNetworkPerformanceMetricSubscription' :: EnableAwsNetworkPerformanceMetricSubscription -> Maybe Text
$sel:metric:EnableAwsNetworkPerformanceMetricSubscription' :: EnableAwsNetworkPerformanceMetricSubscription -> Maybe MetricType
$sel:dryRun:EnableAwsNetworkPerformanceMetricSubscription' :: EnableAwsNetworkPerformanceMetricSubscription -> Maybe Bool
$sel:destination:EnableAwsNetworkPerformanceMetricSubscription' :: EnableAwsNetworkPerformanceMetricSubscription -> Maybe Text
..} =
      forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
destination
        seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Bool
dryRun
        seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe MetricType
metric
        seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
source
        seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe StatisticType
statistic

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

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

instance
  Data.ToQuery
    EnableAwsNetworkPerformanceMetricSubscription
  where
  toQuery :: EnableAwsNetworkPerformanceMetricSubscription -> QueryString
toQuery
    EnableAwsNetworkPerformanceMetricSubscription' {Maybe Bool
Maybe Text
Maybe MetricType
Maybe StatisticType
statistic :: Maybe StatisticType
source :: Maybe Text
metric :: Maybe MetricType
dryRun :: Maybe Bool
destination :: Maybe Text
$sel:statistic:EnableAwsNetworkPerformanceMetricSubscription' :: EnableAwsNetworkPerformanceMetricSubscription
-> Maybe StatisticType
$sel:source:EnableAwsNetworkPerformanceMetricSubscription' :: EnableAwsNetworkPerformanceMetricSubscription -> Maybe Text
$sel:metric:EnableAwsNetworkPerformanceMetricSubscription' :: EnableAwsNetworkPerformanceMetricSubscription -> Maybe MetricType
$sel:dryRun:EnableAwsNetworkPerformanceMetricSubscription' :: EnableAwsNetworkPerformanceMetricSubscription -> Maybe Bool
$sel:destination:EnableAwsNetworkPerformanceMetricSubscription' :: EnableAwsNetworkPerformanceMetricSubscription -> Maybe Text
..} =
      forall a. Monoid a => [a] -> a
Prelude.mconcat
        [ ByteString
"Action"
            forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: ( ByteString
"EnableAwsNetworkPerformanceMetricSubscription" ::
                        Prelude.ByteString
                    ),
          ByteString
"Version"
            forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: (ByteString
"2016-11-15" :: Prelude.ByteString),
          ByteString
"Destination" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Text
destination,
          ByteString
"DryRun" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Bool
dryRun,
          ByteString
"Metric" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe MetricType
metric,
          ByteString
"Source" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Text
source,
          ByteString
"Statistic" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe StatisticType
statistic
        ]

-- | /See:/ 'newEnableAwsNetworkPerformanceMetricSubscriptionResponse' smart constructor.
data EnableAwsNetworkPerformanceMetricSubscriptionResponse = EnableAwsNetworkPerformanceMetricSubscriptionResponse'
  { -- | Indicates whether the subscribe action was successful.
    EnableAwsNetworkPerformanceMetricSubscriptionResponse -> Maybe Bool
output :: Prelude.Maybe Prelude.Bool,
    -- | The response's http status code.
    EnableAwsNetworkPerformanceMetricSubscriptionResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (EnableAwsNetworkPerformanceMetricSubscriptionResponse
-> EnableAwsNetworkPerformanceMetricSubscriptionResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: EnableAwsNetworkPerformanceMetricSubscriptionResponse
-> EnableAwsNetworkPerformanceMetricSubscriptionResponse -> Bool
$c/= :: EnableAwsNetworkPerformanceMetricSubscriptionResponse
-> EnableAwsNetworkPerformanceMetricSubscriptionResponse -> Bool
== :: EnableAwsNetworkPerformanceMetricSubscriptionResponse
-> EnableAwsNetworkPerformanceMetricSubscriptionResponse -> Bool
$c== :: EnableAwsNetworkPerformanceMetricSubscriptionResponse
-> EnableAwsNetworkPerformanceMetricSubscriptionResponse -> Bool
Prelude.Eq, ReadPrec [EnableAwsNetworkPerformanceMetricSubscriptionResponse]
ReadPrec EnableAwsNetworkPerformanceMetricSubscriptionResponse
Int -> ReadS EnableAwsNetworkPerformanceMetricSubscriptionResponse
ReadS [EnableAwsNetworkPerformanceMetricSubscriptionResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [EnableAwsNetworkPerformanceMetricSubscriptionResponse]
$creadListPrec :: ReadPrec [EnableAwsNetworkPerformanceMetricSubscriptionResponse]
readPrec :: ReadPrec EnableAwsNetworkPerformanceMetricSubscriptionResponse
$creadPrec :: ReadPrec EnableAwsNetworkPerformanceMetricSubscriptionResponse
readList :: ReadS [EnableAwsNetworkPerformanceMetricSubscriptionResponse]
$creadList :: ReadS [EnableAwsNetworkPerformanceMetricSubscriptionResponse]
readsPrec :: Int -> ReadS EnableAwsNetworkPerformanceMetricSubscriptionResponse
$creadsPrec :: Int -> ReadS EnableAwsNetworkPerformanceMetricSubscriptionResponse
Prelude.Read, Int
-> EnableAwsNetworkPerformanceMetricSubscriptionResponse -> ShowS
[EnableAwsNetworkPerformanceMetricSubscriptionResponse] -> ShowS
EnableAwsNetworkPerformanceMetricSubscriptionResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [EnableAwsNetworkPerformanceMetricSubscriptionResponse] -> ShowS
$cshowList :: [EnableAwsNetworkPerformanceMetricSubscriptionResponse] -> ShowS
show :: EnableAwsNetworkPerformanceMetricSubscriptionResponse -> String
$cshow :: EnableAwsNetworkPerformanceMetricSubscriptionResponse -> String
showsPrec :: Int
-> EnableAwsNetworkPerformanceMetricSubscriptionResponse -> ShowS
$cshowsPrec :: Int
-> EnableAwsNetworkPerformanceMetricSubscriptionResponse -> ShowS
Prelude.Show, forall x.
Rep EnableAwsNetworkPerformanceMetricSubscriptionResponse x
-> EnableAwsNetworkPerformanceMetricSubscriptionResponse
forall x.
EnableAwsNetworkPerformanceMetricSubscriptionResponse
-> Rep EnableAwsNetworkPerformanceMetricSubscriptionResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep EnableAwsNetworkPerformanceMetricSubscriptionResponse x
-> EnableAwsNetworkPerformanceMetricSubscriptionResponse
$cfrom :: forall x.
EnableAwsNetworkPerformanceMetricSubscriptionResponse
-> Rep EnableAwsNetworkPerformanceMetricSubscriptionResponse x
Prelude.Generic)

-- |
-- Create a value of 'EnableAwsNetworkPerformanceMetricSubscriptionResponse' 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:
--
-- 'output', 'enableAwsNetworkPerformanceMetricSubscriptionResponse_output' - Indicates whether the subscribe action was successful.
--
-- 'httpStatus', 'enableAwsNetworkPerformanceMetricSubscriptionResponse_httpStatus' - The response's http status code.
newEnableAwsNetworkPerformanceMetricSubscriptionResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  EnableAwsNetworkPerformanceMetricSubscriptionResponse
newEnableAwsNetworkPerformanceMetricSubscriptionResponse :: Int -> EnableAwsNetworkPerformanceMetricSubscriptionResponse
newEnableAwsNetworkPerformanceMetricSubscriptionResponse
  Int
pHttpStatus_ =
    EnableAwsNetworkPerformanceMetricSubscriptionResponse'
      { $sel:output:EnableAwsNetworkPerformanceMetricSubscriptionResponse' :: Maybe Bool
output =
          forall a. Maybe a
Prelude.Nothing,
        $sel:httpStatus:EnableAwsNetworkPerformanceMetricSubscriptionResponse' :: Int
httpStatus =
          Int
pHttpStatus_
      }

-- | Indicates whether the subscribe action was successful.
enableAwsNetworkPerformanceMetricSubscriptionResponse_output :: Lens.Lens' EnableAwsNetworkPerformanceMetricSubscriptionResponse (Prelude.Maybe Prelude.Bool)
enableAwsNetworkPerformanceMetricSubscriptionResponse_output :: Lens'
  EnableAwsNetworkPerformanceMetricSubscriptionResponse (Maybe Bool)
enableAwsNetworkPerformanceMetricSubscriptionResponse_output = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\EnableAwsNetworkPerformanceMetricSubscriptionResponse' {Maybe Bool
output :: Maybe Bool
$sel:output:EnableAwsNetworkPerformanceMetricSubscriptionResponse' :: EnableAwsNetworkPerformanceMetricSubscriptionResponse -> Maybe Bool
output} -> Maybe Bool
output) (\s :: EnableAwsNetworkPerformanceMetricSubscriptionResponse
s@EnableAwsNetworkPerformanceMetricSubscriptionResponse' {} Maybe Bool
a -> EnableAwsNetworkPerformanceMetricSubscriptionResponse
s {$sel:output:EnableAwsNetworkPerformanceMetricSubscriptionResponse' :: Maybe Bool
output = Maybe Bool
a} :: EnableAwsNetworkPerformanceMetricSubscriptionResponse)

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

instance
  Prelude.NFData
    EnableAwsNetworkPerformanceMetricSubscriptionResponse
  where
  rnf :: EnableAwsNetworkPerformanceMetricSubscriptionResponse -> ()
rnf
    EnableAwsNetworkPerformanceMetricSubscriptionResponse' {Int
Maybe Bool
httpStatus :: Int
output :: Maybe Bool
$sel:httpStatus:EnableAwsNetworkPerformanceMetricSubscriptionResponse' :: EnableAwsNetworkPerformanceMetricSubscriptionResponse -> Int
$sel:output:EnableAwsNetworkPerformanceMetricSubscriptionResponse' :: EnableAwsNetworkPerformanceMetricSubscriptionResponse -> Maybe Bool
..} =
      forall a. NFData a => a -> ()
Prelude.rnf Maybe Bool
output
        seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus