{-# 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.Personalize.UpdateMetricAttribution
-- 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 a metric attribution.
module Amazonka.Personalize.UpdateMetricAttribution
  ( -- * Creating a Request
    UpdateMetricAttribution (..),
    newUpdateMetricAttribution,

    -- * Request Lenses
    updateMetricAttribution_addMetrics,
    updateMetricAttribution_metricAttributionArn,
    updateMetricAttribution_metricsOutputConfig,
    updateMetricAttribution_removeMetrics,

    -- * Destructuring the Response
    UpdateMetricAttributionResponse (..),
    newUpdateMetricAttributionResponse,

    -- * Response Lenses
    updateMetricAttributionResponse_metricAttributionArn,
    updateMetricAttributionResponse_httpStatus,
  )
where

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

-- | /See:/ 'newUpdateMetricAttribution' smart constructor.
data UpdateMetricAttribution = UpdateMetricAttribution'
  { -- | Add new metric attributes to the metric attribution.
    UpdateMetricAttribution -> Maybe [MetricAttribute]
addMetrics :: Prelude.Maybe [MetricAttribute],
    -- | The Amazon Resource Name (ARN) for the metric attribution to update.
    UpdateMetricAttribution -> Maybe Text
metricAttributionArn :: Prelude.Maybe Prelude.Text,
    -- | An output config for the metric attribution.
    UpdateMetricAttribution -> Maybe MetricAttributionOutput
metricsOutputConfig :: Prelude.Maybe MetricAttributionOutput,
    -- | Remove metric attributes from the metric attribution.
    UpdateMetricAttribution -> Maybe [Text]
removeMetrics :: Prelude.Maybe [Prelude.Text]
  }
  deriving (UpdateMetricAttribution -> UpdateMetricAttribution -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UpdateMetricAttribution -> UpdateMetricAttribution -> Bool
$c/= :: UpdateMetricAttribution -> UpdateMetricAttribution -> Bool
== :: UpdateMetricAttribution -> UpdateMetricAttribution -> Bool
$c== :: UpdateMetricAttribution -> UpdateMetricAttribution -> Bool
Prelude.Eq, ReadPrec [UpdateMetricAttribution]
ReadPrec UpdateMetricAttribution
Int -> ReadS UpdateMetricAttribution
ReadS [UpdateMetricAttribution]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [UpdateMetricAttribution]
$creadListPrec :: ReadPrec [UpdateMetricAttribution]
readPrec :: ReadPrec UpdateMetricAttribution
$creadPrec :: ReadPrec UpdateMetricAttribution
readList :: ReadS [UpdateMetricAttribution]
$creadList :: ReadS [UpdateMetricAttribution]
readsPrec :: Int -> ReadS UpdateMetricAttribution
$creadsPrec :: Int -> ReadS UpdateMetricAttribution
Prelude.Read, Int -> UpdateMetricAttribution -> ShowS
[UpdateMetricAttribution] -> ShowS
UpdateMetricAttribution -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UpdateMetricAttribution] -> ShowS
$cshowList :: [UpdateMetricAttribution] -> ShowS
show :: UpdateMetricAttribution -> String
$cshow :: UpdateMetricAttribution -> String
showsPrec :: Int -> UpdateMetricAttribution -> ShowS
$cshowsPrec :: Int -> UpdateMetricAttribution -> ShowS
Prelude.Show, forall x. Rep UpdateMetricAttribution x -> UpdateMetricAttribution
forall x. UpdateMetricAttribution -> Rep UpdateMetricAttribution x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep UpdateMetricAttribution x -> UpdateMetricAttribution
$cfrom :: forall x. UpdateMetricAttribution -> Rep UpdateMetricAttribution x
Prelude.Generic)

-- |
-- Create a value of 'UpdateMetricAttribution' 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:
--
-- 'addMetrics', 'updateMetricAttribution_addMetrics' - Add new metric attributes to the metric attribution.
--
-- 'metricAttributionArn', 'updateMetricAttribution_metricAttributionArn' - The Amazon Resource Name (ARN) for the metric attribution to update.
--
-- 'metricsOutputConfig', 'updateMetricAttribution_metricsOutputConfig' - An output config for the metric attribution.
--
-- 'removeMetrics', 'updateMetricAttribution_removeMetrics' - Remove metric attributes from the metric attribution.
newUpdateMetricAttribution ::
  UpdateMetricAttribution
newUpdateMetricAttribution :: UpdateMetricAttribution
newUpdateMetricAttribution =
  UpdateMetricAttribution'
    { $sel:addMetrics:UpdateMetricAttribution' :: Maybe [MetricAttribute]
addMetrics =
        forall a. Maybe a
Prelude.Nothing,
      $sel:metricAttributionArn:UpdateMetricAttribution' :: Maybe Text
metricAttributionArn = forall a. Maybe a
Prelude.Nothing,
      $sel:metricsOutputConfig:UpdateMetricAttribution' :: Maybe MetricAttributionOutput
metricsOutputConfig = forall a. Maybe a
Prelude.Nothing,
      $sel:removeMetrics:UpdateMetricAttribution' :: Maybe [Text]
removeMetrics = forall a. Maybe a
Prelude.Nothing
    }

-- | Add new metric attributes to the metric attribution.
updateMetricAttribution_addMetrics :: Lens.Lens' UpdateMetricAttribution (Prelude.Maybe [MetricAttribute])
updateMetricAttribution_addMetrics :: Lens' UpdateMetricAttribution (Maybe [MetricAttribute])
updateMetricAttribution_addMetrics = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateMetricAttribution' {Maybe [MetricAttribute]
addMetrics :: Maybe [MetricAttribute]
$sel:addMetrics:UpdateMetricAttribution' :: UpdateMetricAttribution -> Maybe [MetricAttribute]
addMetrics} -> Maybe [MetricAttribute]
addMetrics) (\s :: UpdateMetricAttribution
s@UpdateMetricAttribution' {} Maybe [MetricAttribute]
a -> UpdateMetricAttribution
s {$sel:addMetrics:UpdateMetricAttribution' :: Maybe [MetricAttribute]
addMetrics = Maybe [MetricAttribute]
a} :: UpdateMetricAttribution) 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 Amazon Resource Name (ARN) for the metric attribution to update.
updateMetricAttribution_metricAttributionArn :: Lens.Lens' UpdateMetricAttribution (Prelude.Maybe Prelude.Text)
updateMetricAttribution_metricAttributionArn :: Lens' UpdateMetricAttribution (Maybe Text)
updateMetricAttribution_metricAttributionArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateMetricAttribution' {Maybe Text
metricAttributionArn :: Maybe Text
$sel:metricAttributionArn:UpdateMetricAttribution' :: UpdateMetricAttribution -> Maybe Text
metricAttributionArn} -> Maybe Text
metricAttributionArn) (\s :: UpdateMetricAttribution
s@UpdateMetricAttribution' {} Maybe Text
a -> UpdateMetricAttribution
s {$sel:metricAttributionArn:UpdateMetricAttribution' :: Maybe Text
metricAttributionArn = Maybe Text
a} :: UpdateMetricAttribution)

-- | An output config for the metric attribution.
updateMetricAttribution_metricsOutputConfig :: Lens.Lens' UpdateMetricAttribution (Prelude.Maybe MetricAttributionOutput)
updateMetricAttribution_metricsOutputConfig :: Lens' UpdateMetricAttribution (Maybe MetricAttributionOutput)
updateMetricAttribution_metricsOutputConfig = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateMetricAttribution' {Maybe MetricAttributionOutput
metricsOutputConfig :: Maybe MetricAttributionOutput
$sel:metricsOutputConfig:UpdateMetricAttribution' :: UpdateMetricAttribution -> Maybe MetricAttributionOutput
metricsOutputConfig} -> Maybe MetricAttributionOutput
metricsOutputConfig) (\s :: UpdateMetricAttribution
s@UpdateMetricAttribution' {} Maybe MetricAttributionOutput
a -> UpdateMetricAttribution
s {$sel:metricsOutputConfig:UpdateMetricAttribution' :: Maybe MetricAttributionOutput
metricsOutputConfig = Maybe MetricAttributionOutput
a} :: UpdateMetricAttribution)

-- | Remove metric attributes from the metric attribution.
updateMetricAttribution_removeMetrics :: Lens.Lens' UpdateMetricAttribution (Prelude.Maybe [Prelude.Text])
updateMetricAttribution_removeMetrics :: Lens' UpdateMetricAttribution (Maybe [Text])
updateMetricAttribution_removeMetrics = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateMetricAttribution' {Maybe [Text]
removeMetrics :: Maybe [Text]
$sel:removeMetrics:UpdateMetricAttribution' :: UpdateMetricAttribution -> Maybe [Text]
removeMetrics} -> Maybe [Text]
removeMetrics) (\s :: UpdateMetricAttribution
s@UpdateMetricAttribution' {} Maybe [Text]
a -> UpdateMetricAttribution
s {$sel:removeMetrics:UpdateMetricAttribution' :: Maybe [Text]
removeMetrics = Maybe [Text]
a} :: UpdateMetricAttribution) 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

instance Core.AWSRequest UpdateMetricAttribution where
  type
    AWSResponse UpdateMetricAttribution =
      UpdateMetricAttributionResponse
  request :: (Service -> Service)
-> UpdateMetricAttribution -> Request UpdateMetricAttribution
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 UpdateMetricAttribution
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse UpdateMetricAttribution)))
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 -> Int -> UpdateMetricAttributionResponse
UpdateMetricAttributionResponse'
            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
"metricAttributionArn")
            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 UpdateMetricAttribution where
  hashWithSalt :: Int -> UpdateMetricAttribution -> Int
hashWithSalt Int
_salt UpdateMetricAttribution' {Maybe [Text]
Maybe [MetricAttribute]
Maybe Text
Maybe MetricAttributionOutput
removeMetrics :: Maybe [Text]
metricsOutputConfig :: Maybe MetricAttributionOutput
metricAttributionArn :: Maybe Text
addMetrics :: Maybe [MetricAttribute]
$sel:removeMetrics:UpdateMetricAttribution' :: UpdateMetricAttribution -> Maybe [Text]
$sel:metricsOutputConfig:UpdateMetricAttribution' :: UpdateMetricAttribution -> Maybe MetricAttributionOutput
$sel:metricAttributionArn:UpdateMetricAttribution' :: UpdateMetricAttribution -> Maybe Text
$sel:addMetrics:UpdateMetricAttribution' :: UpdateMetricAttribution -> Maybe [MetricAttribute]
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [MetricAttribute]
addMetrics
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
metricAttributionArn
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe MetricAttributionOutput
metricsOutputConfig
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [Text]
removeMetrics

instance Prelude.NFData UpdateMetricAttribution where
  rnf :: UpdateMetricAttribution -> ()
rnf UpdateMetricAttribution' {Maybe [Text]
Maybe [MetricAttribute]
Maybe Text
Maybe MetricAttributionOutput
removeMetrics :: Maybe [Text]
metricsOutputConfig :: Maybe MetricAttributionOutput
metricAttributionArn :: Maybe Text
addMetrics :: Maybe [MetricAttribute]
$sel:removeMetrics:UpdateMetricAttribution' :: UpdateMetricAttribution -> Maybe [Text]
$sel:metricsOutputConfig:UpdateMetricAttribution' :: UpdateMetricAttribution -> Maybe MetricAttributionOutput
$sel:metricAttributionArn:UpdateMetricAttribution' :: UpdateMetricAttribution -> Maybe Text
$sel:addMetrics:UpdateMetricAttribution' :: UpdateMetricAttribution -> Maybe [MetricAttribute]
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe [MetricAttribute]
addMetrics
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
metricAttributionArn
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe MetricAttributionOutput
metricsOutputConfig
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [Text]
removeMetrics

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

instance Data.ToJSON UpdateMetricAttribution where
  toJSON :: UpdateMetricAttribution -> Value
toJSON UpdateMetricAttribution' {Maybe [Text]
Maybe [MetricAttribute]
Maybe Text
Maybe MetricAttributionOutput
removeMetrics :: Maybe [Text]
metricsOutputConfig :: Maybe MetricAttributionOutput
metricAttributionArn :: Maybe Text
addMetrics :: Maybe [MetricAttribute]
$sel:removeMetrics:UpdateMetricAttribution' :: UpdateMetricAttribution -> Maybe [Text]
$sel:metricsOutputConfig:UpdateMetricAttribution' :: UpdateMetricAttribution -> Maybe MetricAttributionOutput
$sel:metricAttributionArn:UpdateMetricAttribution' :: UpdateMetricAttribution -> Maybe Text
$sel:addMetrics:UpdateMetricAttribution' :: UpdateMetricAttribution -> Maybe [MetricAttribute]
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"addMetrics" 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 [MetricAttribute]
addMetrics,
            (Key
"metricAttributionArn" 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
metricAttributionArn,
            (Key
"metricsOutputConfig" 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 MetricAttributionOutput
metricsOutputConfig,
            (Key
"removeMetrics" 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]
removeMetrics
          ]
      )

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

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

-- | /See:/ 'newUpdateMetricAttributionResponse' smart constructor.
data UpdateMetricAttributionResponse = UpdateMetricAttributionResponse'
  { -- | The Amazon Resource Name (ARN) for the metric attribution that you
    -- updated.
    UpdateMetricAttributionResponse -> Maybe Text
metricAttributionArn :: Prelude.Maybe Prelude.Text,
    -- | The response's http status code.
    UpdateMetricAttributionResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (UpdateMetricAttributionResponse
-> UpdateMetricAttributionResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UpdateMetricAttributionResponse
-> UpdateMetricAttributionResponse -> Bool
$c/= :: UpdateMetricAttributionResponse
-> UpdateMetricAttributionResponse -> Bool
== :: UpdateMetricAttributionResponse
-> UpdateMetricAttributionResponse -> Bool
$c== :: UpdateMetricAttributionResponse
-> UpdateMetricAttributionResponse -> Bool
Prelude.Eq, ReadPrec [UpdateMetricAttributionResponse]
ReadPrec UpdateMetricAttributionResponse
Int -> ReadS UpdateMetricAttributionResponse
ReadS [UpdateMetricAttributionResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [UpdateMetricAttributionResponse]
$creadListPrec :: ReadPrec [UpdateMetricAttributionResponse]
readPrec :: ReadPrec UpdateMetricAttributionResponse
$creadPrec :: ReadPrec UpdateMetricAttributionResponse
readList :: ReadS [UpdateMetricAttributionResponse]
$creadList :: ReadS [UpdateMetricAttributionResponse]
readsPrec :: Int -> ReadS UpdateMetricAttributionResponse
$creadsPrec :: Int -> ReadS UpdateMetricAttributionResponse
Prelude.Read, Int -> UpdateMetricAttributionResponse -> ShowS
[UpdateMetricAttributionResponse] -> ShowS
UpdateMetricAttributionResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UpdateMetricAttributionResponse] -> ShowS
$cshowList :: [UpdateMetricAttributionResponse] -> ShowS
show :: UpdateMetricAttributionResponse -> String
$cshow :: UpdateMetricAttributionResponse -> String
showsPrec :: Int -> UpdateMetricAttributionResponse -> ShowS
$cshowsPrec :: Int -> UpdateMetricAttributionResponse -> ShowS
Prelude.Show, forall x.
Rep UpdateMetricAttributionResponse x
-> UpdateMetricAttributionResponse
forall x.
UpdateMetricAttributionResponse
-> Rep UpdateMetricAttributionResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep UpdateMetricAttributionResponse x
-> UpdateMetricAttributionResponse
$cfrom :: forall x.
UpdateMetricAttributionResponse
-> Rep UpdateMetricAttributionResponse x
Prelude.Generic)

-- |
-- Create a value of 'UpdateMetricAttributionResponse' 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:
--
-- 'metricAttributionArn', 'updateMetricAttributionResponse_metricAttributionArn' - The Amazon Resource Name (ARN) for the metric attribution that you
-- updated.
--
-- 'httpStatus', 'updateMetricAttributionResponse_httpStatus' - The response's http status code.
newUpdateMetricAttributionResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  UpdateMetricAttributionResponse
newUpdateMetricAttributionResponse :: Int -> UpdateMetricAttributionResponse
newUpdateMetricAttributionResponse Int
pHttpStatus_ =
  UpdateMetricAttributionResponse'
    { $sel:metricAttributionArn:UpdateMetricAttributionResponse' :: Maybe Text
metricAttributionArn =
        forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:UpdateMetricAttributionResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | The Amazon Resource Name (ARN) for the metric attribution that you
-- updated.
updateMetricAttributionResponse_metricAttributionArn :: Lens.Lens' UpdateMetricAttributionResponse (Prelude.Maybe Prelude.Text)
updateMetricAttributionResponse_metricAttributionArn :: Lens' UpdateMetricAttributionResponse (Maybe Text)
updateMetricAttributionResponse_metricAttributionArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateMetricAttributionResponse' {Maybe Text
metricAttributionArn :: Maybe Text
$sel:metricAttributionArn:UpdateMetricAttributionResponse' :: UpdateMetricAttributionResponse -> Maybe Text
metricAttributionArn} -> Maybe Text
metricAttributionArn) (\s :: UpdateMetricAttributionResponse
s@UpdateMetricAttributionResponse' {} Maybe Text
a -> UpdateMetricAttributionResponse
s {$sel:metricAttributionArn:UpdateMetricAttributionResponse' :: Maybe Text
metricAttributionArn = Maybe Text
a} :: UpdateMetricAttributionResponse)

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

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