{-# 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.DynamoDB.UpdateContributorInsights
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Updates the status for contributor insights for a specific table or
-- index. CloudWatch Contributor Insights for DynamoDB graphs display the
-- partition key and (if applicable) sort key of frequently accessed items
-- and frequently throttled items in plaintext. If you require the use of
-- Amazon Web Services Key Management Service (KMS) to encrypt this table’s
-- partition key and sort key data with an Amazon Web Services managed key
-- or customer managed key, you should not enable CloudWatch Contributor
-- Insights for DynamoDB for this table.
module Amazonka.DynamoDB.UpdateContributorInsights
  ( -- * Creating a Request
    UpdateContributorInsights (..),
    newUpdateContributorInsights,

    -- * Request Lenses
    updateContributorInsights_indexName,
    updateContributorInsights_tableName,
    updateContributorInsights_contributorInsightsAction,

    -- * Destructuring the Response
    UpdateContributorInsightsResponse (..),
    newUpdateContributorInsightsResponse,

    -- * Response Lenses
    updateContributorInsightsResponse_contributorInsightsStatus,
    updateContributorInsightsResponse_indexName,
    updateContributorInsightsResponse_tableName,
    updateContributorInsightsResponse_httpStatus,
  )
where

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

-- | /See:/ 'newUpdateContributorInsights' smart constructor.
data UpdateContributorInsights = UpdateContributorInsights'
  { -- | The global secondary index name, if applicable.
    UpdateContributorInsights -> Maybe Text
indexName :: Prelude.Maybe Prelude.Text,
    -- | The name of the table.
    UpdateContributorInsights -> Text
tableName :: Prelude.Text,
    -- | Represents the contributor insights action.
    UpdateContributorInsights -> ContributorInsightsAction
contributorInsightsAction :: ContributorInsightsAction
  }
  deriving (UpdateContributorInsights -> UpdateContributorInsights -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UpdateContributorInsights -> UpdateContributorInsights -> Bool
$c/= :: UpdateContributorInsights -> UpdateContributorInsights -> Bool
== :: UpdateContributorInsights -> UpdateContributorInsights -> Bool
$c== :: UpdateContributorInsights -> UpdateContributorInsights -> Bool
Prelude.Eq, ReadPrec [UpdateContributorInsights]
ReadPrec UpdateContributorInsights
Int -> ReadS UpdateContributorInsights
ReadS [UpdateContributorInsights]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [UpdateContributorInsights]
$creadListPrec :: ReadPrec [UpdateContributorInsights]
readPrec :: ReadPrec UpdateContributorInsights
$creadPrec :: ReadPrec UpdateContributorInsights
readList :: ReadS [UpdateContributorInsights]
$creadList :: ReadS [UpdateContributorInsights]
readsPrec :: Int -> ReadS UpdateContributorInsights
$creadsPrec :: Int -> ReadS UpdateContributorInsights
Prelude.Read, Int -> UpdateContributorInsights -> ShowS
[UpdateContributorInsights] -> ShowS
UpdateContributorInsights -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UpdateContributorInsights] -> ShowS
$cshowList :: [UpdateContributorInsights] -> ShowS
show :: UpdateContributorInsights -> String
$cshow :: UpdateContributorInsights -> String
showsPrec :: Int -> UpdateContributorInsights -> ShowS
$cshowsPrec :: Int -> UpdateContributorInsights -> ShowS
Prelude.Show, forall x.
Rep UpdateContributorInsights x -> UpdateContributorInsights
forall x.
UpdateContributorInsights -> Rep UpdateContributorInsights x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep UpdateContributorInsights x -> UpdateContributorInsights
$cfrom :: forall x.
UpdateContributorInsights -> Rep UpdateContributorInsights x
Prelude.Generic)

-- |
-- Create a value of 'UpdateContributorInsights' 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:
--
-- 'indexName', 'updateContributorInsights_indexName' - The global secondary index name, if applicable.
--
-- 'tableName', 'updateContributorInsights_tableName' - The name of the table.
--
-- 'contributorInsightsAction', 'updateContributorInsights_contributorInsightsAction' - Represents the contributor insights action.
newUpdateContributorInsights ::
  -- | 'tableName'
  Prelude.Text ->
  -- | 'contributorInsightsAction'
  ContributorInsightsAction ->
  UpdateContributorInsights
newUpdateContributorInsights :: Text -> ContributorInsightsAction -> UpdateContributorInsights
newUpdateContributorInsights
  Text
pTableName_
  ContributorInsightsAction
pContributorInsightsAction_ =
    UpdateContributorInsights'
      { $sel:indexName:UpdateContributorInsights' :: Maybe Text
indexName =
          forall a. Maybe a
Prelude.Nothing,
        $sel:tableName:UpdateContributorInsights' :: Text
tableName = Text
pTableName_,
        $sel:contributorInsightsAction:UpdateContributorInsights' :: ContributorInsightsAction
contributorInsightsAction =
          ContributorInsightsAction
pContributorInsightsAction_
      }

-- | The global secondary index name, if applicable.
updateContributorInsights_indexName :: Lens.Lens' UpdateContributorInsights (Prelude.Maybe Prelude.Text)
updateContributorInsights_indexName :: Lens' UpdateContributorInsights (Maybe Text)
updateContributorInsights_indexName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateContributorInsights' {Maybe Text
indexName :: Maybe Text
$sel:indexName:UpdateContributorInsights' :: UpdateContributorInsights -> Maybe Text
indexName} -> Maybe Text
indexName) (\s :: UpdateContributorInsights
s@UpdateContributorInsights' {} Maybe Text
a -> UpdateContributorInsights
s {$sel:indexName:UpdateContributorInsights' :: Maybe Text
indexName = Maybe Text
a} :: UpdateContributorInsights)

-- | The name of the table.
updateContributorInsights_tableName :: Lens.Lens' UpdateContributorInsights Prelude.Text
updateContributorInsights_tableName :: Lens' UpdateContributorInsights Text
updateContributorInsights_tableName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateContributorInsights' {Text
tableName :: Text
$sel:tableName:UpdateContributorInsights' :: UpdateContributorInsights -> Text
tableName} -> Text
tableName) (\s :: UpdateContributorInsights
s@UpdateContributorInsights' {} Text
a -> UpdateContributorInsights
s {$sel:tableName:UpdateContributorInsights' :: Text
tableName = Text
a} :: UpdateContributorInsights)

-- | Represents the contributor insights action.
updateContributorInsights_contributorInsightsAction :: Lens.Lens' UpdateContributorInsights ContributorInsightsAction
updateContributorInsights_contributorInsightsAction :: Lens' UpdateContributorInsights ContributorInsightsAction
updateContributorInsights_contributorInsightsAction = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateContributorInsights' {ContributorInsightsAction
contributorInsightsAction :: ContributorInsightsAction
$sel:contributorInsightsAction:UpdateContributorInsights' :: UpdateContributorInsights -> ContributorInsightsAction
contributorInsightsAction} -> ContributorInsightsAction
contributorInsightsAction) (\s :: UpdateContributorInsights
s@UpdateContributorInsights' {} ContributorInsightsAction
a -> UpdateContributorInsights
s {$sel:contributorInsightsAction:UpdateContributorInsights' :: ContributorInsightsAction
contributorInsightsAction = ContributorInsightsAction
a} :: UpdateContributorInsights)

instance Core.AWSRequest UpdateContributorInsights where
  type
    AWSResponse UpdateContributorInsights =
      UpdateContributorInsightsResponse
  request :: (Service -> Service)
-> UpdateContributorInsights -> Request UpdateContributorInsights
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 UpdateContributorInsights
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse UpdateContributorInsights)))
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 ContributorInsightsStatus
-> Maybe Text
-> Maybe Text
-> Int
-> UpdateContributorInsightsResponse
UpdateContributorInsightsResponse'
            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
"ContributorInsightsStatus")
            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
"IndexName")
            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
"TableName")
            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 UpdateContributorInsights where
  hashWithSalt :: Int -> UpdateContributorInsights -> Int
hashWithSalt Int
_salt UpdateContributorInsights' {Maybe Text
Text
ContributorInsightsAction
contributorInsightsAction :: ContributorInsightsAction
tableName :: Text
indexName :: Maybe Text
$sel:contributorInsightsAction:UpdateContributorInsights' :: UpdateContributorInsights -> ContributorInsightsAction
$sel:tableName:UpdateContributorInsights' :: UpdateContributorInsights -> Text
$sel:indexName:UpdateContributorInsights' :: UpdateContributorInsights -> Maybe Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
indexName
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
tableName
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` ContributorInsightsAction
contributorInsightsAction

instance Prelude.NFData UpdateContributorInsights where
  rnf :: UpdateContributorInsights -> ()
rnf UpdateContributorInsights' {Maybe Text
Text
ContributorInsightsAction
contributorInsightsAction :: ContributorInsightsAction
tableName :: Text
indexName :: Maybe Text
$sel:contributorInsightsAction:UpdateContributorInsights' :: UpdateContributorInsights -> ContributorInsightsAction
$sel:tableName:UpdateContributorInsights' :: UpdateContributorInsights -> Text
$sel:indexName:UpdateContributorInsights' :: UpdateContributorInsights -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
indexName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
tableName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf ContributorInsightsAction
contributorInsightsAction

instance Data.ToHeaders UpdateContributorInsights where
  toHeaders :: UpdateContributorInsights -> 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
"DynamoDB_20120810.UpdateContributorInsights" ::
                          Prelude.ByteString
                      ),
            HeaderName
"Content-Type"
              forall a. ToHeader a => HeaderName -> a -> ResponseHeaders
Data.=# ( ByteString
"application/x-amz-json-1.0" ::
                          Prelude.ByteString
                      )
          ]
      )

instance Data.ToJSON UpdateContributorInsights where
  toJSON :: UpdateContributorInsights -> Value
toJSON UpdateContributorInsights' {Maybe Text
Text
ContributorInsightsAction
contributorInsightsAction :: ContributorInsightsAction
tableName :: Text
indexName :: Maybe Text
$sel:contributorInsightsAction:UpdateContributorInsights' :: UpdateContributorInsights -> ContributorInsightsAction
$sel:tableName:UpdateContributorInsights' :: UpdateContributorInsights -> Text
$sel:indexName:UpdateContributorInsights' :: UpdateContributorInsights -> Maybe Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"IndexName" 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
indexName,
            forall a. a -> Maybe a
Prelude.Just (Key
"TableName" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
tableName),
            forall a. a -> Maybe a
Prelude.Just
              ( Key
"ContributorInsightsAction"
                  forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= ContributorInsightsAction
contributorInsightsAction
              )
          ]
      )

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

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

-- | /See:/ 'newUpdateContributorInsightsResponse' smart constructor.
data UpdateContributorInsightsResponse = UpdateContributorInsightsResponse'
  { -- | The status of contributor insights
    UpdateContributorInsightsResponse
-> Maybe ContributorInsightsStatus
contributorInsightsStatus :: Prelude.Maybe ContributorInsightsStatus,
    -- | The name of the global secondary index, if applicable.
    UpdateContributorInsightsResponse -> Maybe Text
indexName :: Prelude.Maybe Prelude.Text,
    -- | The name of the table.
    UpdateContributorInsightsResponse -> Maybe Text
tableName :: Prelude.Maybe Prelude.Text,
    -- | The response's http status code.
    UpdateContributorInsightsResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (UpdateContributorInsightsResponse
-> UpdateContributorInsightsResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UpdateContributorInsightsResponse
-> UpdateContributorInsightsResponse -> Bool
$c/= :: UpdateContributorInsightsResponse
-> UpdateContributorInsightsResponse -> Bool
== :: UpdateContributorInsightsResponse
-> UpdateContributorInsightsResponse -> Bool
$c== :: UpdateContributorInsightsResponse
-> UpdateContributorInsightsResponse -> Bool
Prelude.Eq, ReadPrec [UpdateContributorInsightsResponse]
ReadPrec UpdateContributorInsightsResponse
Int -> ReadS UpdateContributorInsightsResponse
ReadS [UpdateContributorInsightsResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [UpdateContributorInsightsResponse]
$creadListPrec :: ReadPrec [UpdateContributorInsightsResponse]
readPrec :: ReadPrec UpdateContributorInsightsResponse
$creadPrec :: ReadPrec UpdateContributorInsightsResponse
readList :: ReadS [UpdateContributorInsightsResponse]
$creadList :: ReadS [UpdateContributorInsightsResponse]
readsPrec :: Int -> ReadS UpdateContributorInsightsResponse
$creadsPrec :: Int -> ReadS UpdateContributorInsightsResponse
Prelude.Read, Int -> UpdateContributorInsightsResponse -> ShowS
[UpdateContributorInsightsResponse] -> ShowS
UpdateContributorInsightsResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UpdateContributorInsightsResponse] -> ShowS
$cshowList :: [UpdateContributorInsightsResponse] -> ShowS
show :: UpdateContributorInsightsResponse -> String
$cshow :: UpdateContributorInsightsResponse -> String
showsPrec :: Int -> UpdateContributorInsightsResponse -> ShowS
$cshowsPrec :: Int -> UpdateContributorInsightsResponse -> ShowS
Prelude.Show, forall x.
Rep UpdateContributorInsightsResponse x
-> UpdateContributorInsightsResponse
forall x.
UpdateContributorInsightsResponse
-> Rep UpdateContributorInsightsResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep UpdateContributorInsightsResponse x
-> UpdateContributorInsightsResponse
$cfrom :: forall x.
UpdateContributorInsightsResponse
-> Rep UpdateContributorInsightsResponse x
Prelude.Generic)

-- |
-- Create a value of 'UpdateContributorInsightsResponse' 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:
--
-- 'contributorInsightsStatus', 'updateContributorInsightsResponse_contributorInsightsStatus' - The status of contributor insights
--
-- 'indexName', 'updateContributorInsightsResponse_indexName' - The name of the global secondary index, if applicable.
--
-- 'tableName', 'updateContributorInsightsResponse_tableName' - The name of the table.
--
-- 'httpStatus', 'updateContributorInsightsResponse_httpStatus' - The response's http status code.
newUpdateContributorInsightsResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  UpdateContributorInsightsResponse
newUpdateContributorInsightsResponse :: Int -> UpdateContributorInsightsResponse
newUpdateContributorInsightsResponse Int
pHttpStatus_ =
  UpdateContributorInsightsResponse'
    { $sel:contributorInsightsStatus:UpdateContributorInsightsResponse' :: Maybe ContributorInsightsStatus
contributorInsightsStatus =
        forall a. Maybe a
Prelude.Nothing,
      $sel:indexName:UpdateContributorInsightsResponse' :: Maybe Text
indexName = forall a. Maybe a
Prelude.Nothing,
      $sel:tableName:UpdateContributorInsightsResponse' :: Maybe Text
tableName = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:UpdateContributorInsightsResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | The status of contributor insights
updateContributorInsightsResponse_contributorInsightsStatus :: Lens.Lens' UpdateContributorInsightsResponse (Prelude.Maybe ContributorInsightsStatus)
updateContributorInsightsResponse_contributorInsightsStatus :: Lens'
  UpdateContributorInsightsResponse (Maybe ContributorInsightsStatus)
updateContributorInsightsResponse_contributorInsightsStatus = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateContributorInsightsResponse' {Maybe ContributorInsightsStatus
contributorInsightsStatus :: Maybe ContributorInsightsStatus
$sel:contributorInsightsStatus:UpdateContributorInsightsResponse' :: UpdateContributorInsightsResponse
-> Maybe ContributorInsightsStatus
contributorInsightsStatus} -> Maybe ContributorInsightsStatus
contributorInsightsStatus) (\s :: UpdateContributorInsightsResponse
s@UpdateContributorInsightsResponse' {} Maybe ContributorInsightsStatus
a -> UpdateContributorInsightsResponse
s {$sel:contributorInsightsStatus:UpdateContributorInsightsResponse' :: Maybe ContributorInsightsStatus
contributorInsightsStatus = Maybe ContributorInsightsStatus
a} :: UpdateContributorInsightsResponse)

-- | The name of the global secondary index, if applicable.
updateContributorInsightsResponse_indexName :: Lens.Lens' UpdateContributorInsightsResponse (Prelude.Maybe Prelude.Text)
updateContributorInsightsResponse_indexName :: Lens' UpdateContributorInsightsResponse (Maybe Text)
updateContributorInsightsResponse_indexName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateContributorInsightsResponse' {Maybe Text
indexName :: Maybe Text
$sel:indexName:UpdateContributorInsightsResponse' :: UpdateContributorInsightsResponse -> Maybe Text
indexName} -> Maybe Text
indexName) (\s :: UpdateContributorInsightsResponse
s@UpdateContributorInsightsResponse' {} Maybe Text
a -> UpdateContributorInsightsResponse
s {$sel:indexName:UpdateContributorInsightsResponse' :: Maybe Text
indexName = Maybe Text
a} :: UpdateContributorInsightsResponse)

-- | The name of the table.
updateContributorInsightsResponse_tableName :: Lens.Lens' UpdateContributorInsightsResponse (Prelude.Maybe Prelude.Text)
updateContributorInsightsResponse_tableName :: Lens' UpdateContributorInsightsResponse (Maybe Text)
updateContributorInsightsResponse_tableName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateContributorInsightsResponse' {Maybe Text
tableName :: Maybe Text
$sel:tableName:UpdateContributorInsightsResponse' :: UpdateContributorInsightsResponse -> Maybe Text
tableName} -> Maybe Text
tableName) (\s :: UpdateContributorInsightsResponse
s@UpdateContributorInsightsResponse' {} Maybe Text
a -> UpdateContributorInsightsResponse
s {$sel:tableName:UpdateContributorInsightsResponse' :: Maybe Text
tableName = Maybe Text
a} :: UpdateContributorInsightsResponse)

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

instance
  Prelude.NFData
    UpdateContributorInsightsResponse
  where
  rnf :: UpdateContributorInsightsResponse -> ()
rnf UpdateContributorInsightsResponse' {Int
Maybe Text
Maybe ContributorInsightsStatus
httpStatus :: Int
tableName :: Maybe Text
indexName :: Maybe Text
contributorInsightsStatus :: Maybe ContributorInsightsStatus
$sel:httpStatus:UpdateContributorInsightsResponse' :: UpdateContributorInsightsResponse -> Int
$sel:tableName:UpdateContributorInsightsResponse' :: UpdateContributorInsightsResponse -> Maybe Text
$sel:indexName:UpdateContributorInsightsResponse' :: UpdateContributorInsightsResponse -> Maybe Text
$sel:contributorInsightsStatus:UpdateContributorInsightsResponse' :: UpdateContributorInsightsResponse
-> Maybe ContributorInsightsStatus
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe ContributorInsightsStatus
contributorInsightsStatus
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
indexName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
tableName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus