{-# 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.Rum.PutRumMetricsDestination
-- 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 or updates a destination to receive extended metrics from
-- CloudWatch RUM. You can send extended metrics to CloudWatch or to a
-- CloudWatch Evidently experiment.
--
-- For more information about extended metrics, see
-- <https://docs.aws.amazon.com/cloudwatchrum/latest/APIReference/API_AddRumMetrics.html AddRumMetrics>.
module Amazonka.Rum.PutRumMetricsDestination
  ( -- * Creating a Request
    PutRumMetricsDestination (..),
    newPutRumMetricsDestination,

    -- * Request Lenses
    putRumMetricsDestination_destinationArn,
    putRumMetricsDestination_iamRoleArn,
    putRumMetricsDestination_appMonitorName,
    putRumMetricsDestination_destination,

    -- * Destructuring the Response
    PutRumMetricsDestinationResponse (..),
    newPutRumMetricsDestinationResponse,

    -- * Response Lenses
    putRumMetricsDestinationResponse_httpStatus,
  )
where

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

-- | /See:/ 'newPutRumMetricsDestination' smart constructor.
data PutRumMetricsDestination = PutRumMetricsDestination'
  { -- | Use this parameter only if @Destination@ is @Evidently@. This parameter
    -- specifies the ARN of the Evidently experiment that will receive the
    -- extended metrics.
    PutRumMetricsDestination -> Maybe Text
destinationArn :: Prelude.Maybe Prelude.Text,
    -- | This parameter is required if @Destination@ is @Evidently@. If
    -- @Destination@ is @CloudWatch@, do not use this parameter.
    --
    -- This parameter specifies the ARN of an IAM role that RUM will assume to
    -- write to the Evidently experiment that you are sending metrics to. This
    -- role must have permission to write to that experiment.
    PutRumMetricsDestination -> Maybe Text
iamRoleArn :: Prelude.Maybe Prelude.Text,
    -- | The name of the CloudWatch RUM app monitor that will send the metrics.
    PutRumMetricsDestination -> Text
appMonitorName :: Prelude.Text,
    -- | Defines the destination to send the metrics to. Valid values are
    -- @CloudWatch@ and @Evidently@. If you specify @Evidently@, you must also
    -- specify the ARN of the CloudWatchEvidently experiment that is to be the
    -- destination and an IAM role that has permission to write to the
    -- experiment.
    PutRumMetricsDestination -> MetricDestination
destination :: MetricDestination
  }
  deriving (PutRumMetricsDestination -> PutRumMetricsDestination -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PutRumMetricsDestination -> PutRumMetricsDestination -> Bool
$c/= :: PutRumMetricsDestination -> PutRumMetricsDestination -> Bool
== :: PutRumMetricsDestination -> PutRumMetricsDestination -> Bool
$c== :: PutRumMetricsDestination -> PutRumMetricsDestination -> Bool
Prelude.Eq, ReadPrec [PutRumMetricsDestination]
ReadPrec PutRumMetricsDestination
Int -> ReadS PutRumMetricsDestination
ReadS [PutRumMetricsDestination]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [PutRumMetricsDestination]
$creadListPrec :: ReadPrec [PutRumMetricsDestination]
readPrec :: ReadPrec PutRumMetricsDestination
$creadPrec :: ReadPrec PutRumMetricsDestination
readList :: ReadS [PutRumMetricsDestination]
$creadList :: ReadS [PutRumMetricsDestination]
readsPrec :: Int -> ReadS PutRumMetricsDestination
$creadsPrec :: Int -> ReadS PutRumMetricsDestination
Prelude.Read, Int -> PutRumMetricsDestination -> ShowS
[PutRumMetricsDestination] -> ShowS
PutRumMetricsDestination -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PutRumMetricsDestination] -> ShowS
$cshowList :: [PutRumMetricsDestination] -> ShowS
show :: PutRumMetricsDestination -> String
$cshow :: PutRumMetricsDestination -> String
showsPrec :: Int -> PutRumMetricsDestination -> ShowS
$cshowsPrec :: Int -> PutRumMetricsDestination -> ShowS
Prelude.Show, forall x.
Rep PutRumMetricsDestination x -> PutRumMetricsDestination
forall x.
PutRumMetricsDestination -> Rep PutRumMetricsDestination x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep PutRumMetricsDestination x -> PutRumMetricsDestination
$cfrom :: forall x.
PutRumMetricsDestination -> Rep PutRumMetricsDestination x
Prelude.Generic)

-- |
-- Create a value of 'PutRumMetricsDestination' 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:
--
-- 'destinationArn', 'putRumMetricsDestination_destinationArn' - Use this parameter only if @Destination@ is @Evidently@. This parameter
-- specifies the ARN of the Evidently experiment that will receive the
-- extended metrics.
--
-- 'iamRoleArn', 'putRumMetricsDestination_iamRoleArn' - This parameter is required if @Destination@ is @Evidently@. If
-- @Destination@ is @CloudWatch@, do not use this parameter.
--
-- This parameter specifies the ARN of an IAM role that RUM will assume to
-- write to the Evidently experiment that you are sending metrics to. This
-- role must have permission to write to that experiment.
--
-- 'appMonitorName', 'putRumMetricsDestination_appMonitorName' - The name of the CloudWatch RUM app monitor that will send the metrics.
--
-- 'destination', 'putRumMetricsDestination_destination' - Defines the destination to send the metrics to. Valid values are
-- @CloudWatch@ and @Evidently@. If you specify @Evidently@, you must also
-- specify the ARN of the CloudWatchEvidently experiment that is to be the
-- destination and an IAM role that has permission to write to the
-- experiment.
newPutRumMetricsDestination ::
  -- | 'appMonitorName'
  Prelude.Text ->
  -- | 'destination'
  MetricDestination ->
  PutRumMetricsDestination
newPutRumMetricsDestination :: Text -> MetricDestination -> PutRumMetricsDestination
newPutRumMetricsDestination
  Text
pAppMonitorName_
  MetricDestination
pDestination_ =
    PutRumMetricsDestination'
      { $sel:destinationArn:PutRumMetricsDestination' :: Maybe Text
destinationArn =
          forall a. Maybe a
Prelude.Nothing,
        $sel:iamRoleArn:PutRumMetricsDestination' :: Maybe Text
iamRoleArn = forall a. Maybe a
Prelude.Nothing,
        $sel:appMonitorName:PutRumMetricsDestination' :: Text
appMonitorName = Text
pAppMonitorName_,
        $sel:destination:PutRumMetricsDestination' :: MetricDestination
destination = MetricDestination
pDestination_
      }

-- | Use this parameter only if @Destination@ is @Evidently@. This parameter
-- specifies the ARN of the Evidently experiment that will receive the
-- extended metrics.
putRumMetricsDestination_destinationArn :: Lens.Lens' PutRumMetricsDestination (Prelude.Maybe Prelude.Text)
putRumMetricsDestination_destinationArn :: Lens' PutRumMetricsDestination (Maybe Text)
putRumMetricsDestination_destinationArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PutRumMetricsDestination' {Maybe Text
destinationArn :: Maybe Text
$sel:destinationArn:PutRumMetricsDestination' :: PutRumMetricsDestination -> Maybe Text
destinationArn} -> Maybe Text
destinationArn) (\s :: PutRumMetricsDestination
s@PutRumMetricsDestination' {} Maybe Text
a -> PutRumMetricsDestination
s {$sel:destinationArn:PutRumMetricsDestination' :: Maybe Text
destinationArn = Maybe Text
a} :: PutRumMetricsDestination)

-- | This parameter is required if @Destination@ is @Evidently@. If
-- @Destination@ is @CloudWatch@, do not use this parameter.
--
-- This parameter specifies the ARN of an IAM role that RUM will assume to
-- write to the Evidently experiment that you are sending metrics to. This
-- role must have permission to write to that experiment.
putRumMetricsDestination_iamRoleArn :: Lens.Lens' PutRumMetricsDestination (Prelude.Maybe Prelude.Text)
putRumMetricsDestination_iamRoleArn :: Lens' PutRumMetricsDestination (Maybe Text)
putRumMetricsDestination_iamRoleArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PutRumMetricsDestination' {Maybe Text
iamRoleArn :: Maybe Text
$sel:iamRoleArn:PutRumMetricsDestination' :: PutRumMetricsDestination -> Maybe Text
iamRoleArn} -> Maybe Text
iamRoleArn) (\s :: PutRumMetricsDestination
s@PutRumMetricsDestination' {} Maybe Text
a -> PutRumMetricsDestination
s {$sel:iamRoleArn:PutRumMetricsDestination' :: Maybe Text
iamRoleArn = Maybe Text
a} :: PutRumMetricsDestination)

-- | The name of the CloudWatch RUM app monitor that will send the metrics.
putRumMetricsDestination_appMonitorName :: Lens.Lens' PutRumMetricsDestination Prelude.Text
putRumMetricsDestination_appMonitorName :: Lens' PutRumMetricsDestination Text
putRumMetricsDestination_appMonitorName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PutRumMetricsDestination' {Text
appMonitorName :: Text
$sel:appMonitorName:PutRumMetricsDestination' :: PutRumMetricsDestination -> Text
appMonitorName} -> Text
appMonitorName) (\s :: PutRumMetricsDestination
s@PutRumMetricsDestination' {} Text
a -> PutRumMetricsDestination
s {$sel:appMonitorName:PutRumMetricsDestination' :: Text
appMonitorName = Text
a} :: PutRumMetricsDestination)

-- | Defines the destination to send the metrics to. Valid values are
-- @CloudWatch@ and @Evidently@. If you specify @Evidently@, you must also
-- specify the ARN of the CloudWatchEvidently experiment that is to be the
-- destination and an IAM role that has permission to write to the
-- experiment.
putRumMetricsDestination_destination :: Lens.Lens' PutRumMetricsDestination MetricDestination
putRumMetricsDestination_destination :: Lens' PutRumMetricsDestination MetricDestination
putRumMetricsDestination_destination = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PutRumMetricsDestination' {MetricDestination
destination :: MetricDestination
$sel:destination:PutRumMetricsDestination' :: PutRumMetricsDestination -> MetricDestination
destination} -> MetricDestination
destination) (\s :: PutRumMetricsDestination
s@PutRumMetricsDestination' {} MetricDestination
a -> PutRumMetricsDestination
s {$sel:destination:PutRumMetricsDestination' :: MetricDestination
destination = MetricDestination
a} :: PutRumMetricsDestination)

instance Core.AWSRequest PutRumMetricsDestination where
  type
    AWSResponse PutRumMetricsDestination =
      PutRumMetricsDestinationResponse
  request :: (Service -> Service)
-> PutRumMetricsDestination -> Request PutRumMetricsDestination
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 PutRumMetricsDestination
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse PutRumMetricsDestination)))
response =
    forall (m :: * -> *) a.
MonadResource m =>
(Int -> ResponseHeaders -> () -> Either String (AWSResponse a))
-> (ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy a
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse a)))
Response.receiveEmpty
      ( \Int
s ResponseHeaders
h ()
x ->
          Int -> PutRumMetricsDestinationResponse
PutRumMetricsDestinationResponse'
            forall (f :: * -> *) a b. Functor 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 PutRumMetricsDestination where
  hashWithSalt :: Int -> PutRumMetricsDestination -> Int
hashWithSalt Int
_salt PutRumMetricsDestination' {Maybe Text
Text
MetricDestination
destination :: MetricDestination
appMonitorName :: Text
iamRoleArn :: Maybe Text
destinationArn :: Maybe Text
$sel:destination:PutRumMetricsDestination' :: PutRumMetricsDestination -> MetricDestination
$sel:appMonitorName:PutRumMetricsDestination' :: PutRumMetricsDestination -> Text
$sel:iamRoleArn:PutRumMetricsDestination' :: PutRumMetricsDestination -> Maybe Text
$sel:destinationArn:PutRumMetricsDestination' :: PutRumMetricsDestination -> Maybe Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
destinationArn
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
iamRoleArn
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
appMonitorName
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` MetricDestination
destination

instance Prelude.NFData PutRumMetricsDestination where
  rnf :: PutRumMetricsDestination -> ()
rnf PutRumMetricsDestination' {Maybe Text
Text
MetricDestination
destination :: MetricDestination
appMonitorName :: Text
iamRoleArn :: Maybe Text
destinationArn :: Maybe Text
$sel:destination:PutRumMetricsDestination' :: PutRumMetricsDestination -> MetricDestination
$sel:appMonitorName:PutRumMetricsDestination' :: PutRumMetricsDestination -> Text
$sel:iamRoleArn:PutRumMetricsDestination' :: PutRumMetricsDestination -> Maybe Text
$sel:destinationArn:PutRumMetricsDestination' :: PutRumMetricsDestination -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
destinationArn
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
iamRoleArn
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
appMonitorName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf MetricDestination
destination

instance Data.ToHeaders PutRumMetricsDestination where
  toHeaders :: PutRumMetricsDestination -> ResponseHeaders
toHeaders =
    forall a b. a -> b -> a
Prelude.const
      ( forall a. Monoid a => [a] -> a
Prelude.mconcat
          [ HeaderName
"Content-Type"
              forall a. ToHeader a => HeaderName -> a -> ResponseHeaders
Data.=# ( ByteString
"application/x-amz-json-1.1" ::
                          Prelude.ByteString
                      )
          ]
      )

instance Data.ToJSON PutRumMetricsDestination where
  toJSON :: PutRumMetricsDestination -> Value
toJSON PutRumMetricsDestination' {Maybe Text
Text
MetricDestination
destination :: MetricDestination
appMonitorName :: Text
iamRoleArn :: Maybe Text
destinationArn :: Maybe Text
$sel:destination:PutRumMetricsDestination' :: PutRumMetricsDestination -> MetricDestination
$sel:appMonitorName:PutRumMetricsDestination' :: PutRumMetricsDestination -> Text
$sel:iamRoleArn:PutRumMetricsDestination' :: PutRumMetricsDestination -> Maybe Text
$sel:destinationArn:PutRumMetricsDestination' :: PutRumMetricsDestination -> Maybe Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"DestinationArn" 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
destinationArn,
            (Key
"IamRoleArn" 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
iamRoleArn,
            forall a. a -> Maybe a
Prelude.Just (Key
"Destination" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= MetricDestination
destination)
          ]
      )

instance Data.ToPath PutRumMetricsDestination where
  toPath :: PutRumMetricsDestination -> ByteString
toPath PutRumMetricsDestination' {Maybe Text
Text
MetricDestination
destination :: MetricDestination
appMonitorName :: Text
iamRoleArn :: Maybe Text
destinationArn :: Maybe Text
$sel:destination:PutRumMetricsDestination' :: PutRumMetricsDestination -> MetricDestination
$sel:appMonitorName:PutRumMetricsDestination' :: PutRumMetricsDestination -> Text
$sel:iamRoleArn:PutRumMetricsDestination' :: PutRumMetricsDestination -> Maybe Text
$sel:destinationArn:PutRumMetricsDestination' :: PutRumMetricsDestination -> Maybe Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"/rummetrics/",
        forall a. ToByteString a => a -> ByteString
Data.toBS Text
appMonitorName,
        ByteString
"/metricsdestination"
      ]

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

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

-- |
-- Create a value of 'PutRumMetricsDestinationResponse' 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:
--
-- 'httpStatus', 'putRumMetricsDestinationResponse_httpStatus' - The response's http status code.
newPutRumMetricsDestinationResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  PutRumMetricsDestinationResponse
newPutRumMetricsDestinationResponse :: Int -> PutRumMetricsDestinationResponse
newPutRumMetricsDestinationResponse Int
pHttpStatus_ =
  PutRumMetricsDestinationResponse'
    { $sel:httpStatus:PutRumMetricsDestinationResponse' :: Int
httpStatus =
        Int
pHttpStatus_
    }

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

instance
  Prelude.NFData
    PutRumMetricsDestinationResponse
  where
  rnf :: PutRumMetricsDestinationResponse -> ()
rnf PutRumMetricsDestinationResponse' {Int
httpStatus :: Int
$sel:httpStatus:PutRumMetricsDestinationResponse' :: PutRumMetricsDestinationResponse -> Int
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus