{-# 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.ListContributorInsights
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Returns a list of ContributorInsightsSummary for a table and all its
-- global secondary indexes.
module Amazonka.DynamoDB.ListContributorInsights
  ( -- * Creating a Request
    ListContributorInsights (..),
    newListContributorInsights,

    -- * Request Lenses
    listContributorInsights_maxResults,
    listContributorInsights_nextToken,
    listContributorInsights_tableName,

    -- * Destructuring the Response
    ListContributorInsightsResponse (..),
    newListContributorInsightsResponse,

    -- * Response Lenses
    listContributorInsightsResponse_contributorInsightsSummaries,
    listContributorInsightsResponse_nextToken,
    listContributorInsightsResponse_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:/ 'newListContributorInsights' smart constructor.
data ListContributorInsights = ListContributorInsights'
  { -- | Maximum number of results to return per page.
    ListContributorInsights -> Maybe Int
maxResults :: Prelude.Maybe Prelude.Int,
    -- | A token to for the desired page, if there is one.
    ListContributorInsights -> Maybe Text
nextToken :: Prelude.Maybe Prelude.Text,
    -- | The name of the table.
    ListContributorInsights -> Maybe Text
tableName :: Prelude.Maybe Prelude.Text
  }
  deriving (ListContributorInsights -> ListContributorInsights -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ListContributorInsights -> ListContributorInsights -> Bool
$c/= :: ListContributorInsights -> ListContributorInsights -> Bool
== :: ListContributorInsights -> ListContributorInsights -> Bool
$c== :: ListContributorInsights -> ListContributorInsights -> Bool
Prelude.Eq, ReadPrec [ListContributorInsights]
ReadPrec ListContributorInsights
Int -> ReadS ListContributorInsights
ReadS [ListContributorInsights]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ListContributorInsights]
$creadListPrec :: ReadPrec [ListContributorInsights]
readPrec :: ReadPrec ListContributorInsights
$creadPrec :: ReadPrec ListContributorInsights
readList :: ReadS [ListContributorInsights]
$creadList :: ReadS [ListContributorInsights]
readsPrec :: Int -> ReadS ListContributorInsights
$creadsPrec :: Int -> ReadS ListContributorInsights
Prelude.Read, Int -> ListContributorInsights -> ShowS
[ListContributorInsights] -> ShowS
ListContributorInsights -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ListContributorInsights] -> ShowS
$cshowList :: [ListContributorInsights] -> ShowS
show :: ListContributorInsights -> String
$cshow :: ListContributorInsights -> String
showsPrec :: Int -> ListContributorInsights -> ShowS
$cshowsPrec :: Int -> ListContributorInsights -> ShowS
Prelude.Show, forall x. Rep ListContributorInsights x -> ListContributorInsights
forall x. ListContributorInsights -> Rep ListContributorInsights x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ListContributorInsights x -> ListContributorInsights
$cfrom :: forall x. ListContributorInsights -> Rep ListContributorInsights x
Prelude.Generic)

-- |
-- Create a value of 'ListContributorInsights' 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:
--
-- 'maxResults', 'listContributorInsights_maxResults' - Maximum number of results to return per page.
--
-- 'nextToken', 'listContributorInsights_nextToken' - A token to for the desired page, if there is one.
--
-- 'tableName', 'listContributorInsights_tableName' - The name of the table.
newListContributorInsights ::
  ListContributorInsights
newListContributorInsights :: ListContributorInsights
newListContributorInsights =
  ListContributorInsights'
    { $sel:maxResults:ListContributorInsights' :: Maybe Int
maxResults =
        forall a. Maybe a
Prelude.Nothing,
      $sel:nextToken:ListContributorInsights' :: Maybe Text
nextToken = forall a. Maybe a
Prelude.Nothing,
      $sel:tableName:ListContributorInsights' :: Maybe Text
tableName = forall a. Maybe a
Prelude.Nothing
    }

-- | Maximum number of results to return per page.
listContributorInsights_maxResults :: Lens.Lens' ListContributorInsights (Prelude.Maybe Prelude.Int)
listContributorInsights_maxResults :: Lens' ListContributorInsights (Maybe Int)
listContributorInsights_maxResults = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListContributorInsights' {Maybe Int
maxResults :: Maybe Int
$sel:maxResults:ListContributorInsights' :: ListContributorInsights -> Maybe Int
maxResults} -> Maybe Int
maxResults) (\s :: ListContributorInsights
s@ListContributorInsights' {} Maybe Int
a -> ListContributorInsights
s {$sel:maxResults:ListContributorInsights' :: Maybe Int
maxResults = Maybe Int
a} :: ListContributorInsights)

-- | A token to for the desired page, if there is one.
listContributorInsights_nextToken :: Lens.Lens' ListContributorInsights (Prelude.Maybe Prelude.Text)
listContributorInsights_nextToken :: Lens' ListContributorInsights (Maybe Text)
listContributorInsights_nextToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListContributorInsights' {Maybe Text
nextToken :: Maybe Text
$sel:nextToken:ListContributorInsights' :: ListContributorInsights -> Maybe Text
nextToken} -> Maybe Text
nextToken) (\s :: ListContributorInsights
s@ListContributorInsights' {} Maybe Text
a -> ListContributorInsights
s {$sel:nextToken:ListContributorInsights' :: Maybe Text
nextToken = Maybe Text
a} :: ListContributorInsights)

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

instance Core.AWSRequest ListContributorInsights where
  type
    AWSResponse ListContributorInsights =
      ListContributorInsightsResponse
  request :: (Service -> Service)
-> ListContributorInsights -> Request ListContributorInsights
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 ListContributorInsights
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse ListContributorInsights)))
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 [ContributorInsightsSummary]
-> Maybe Text -> Int -> ListContributorInsightsResponse
ListContributorInsightsResponse'
            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
"ContributorInsightsSummaries"
                            forall (f :: * -> *) a. Functor f => f (Maybe a) -> a -> f a
Core..!@ forall a. Monoid a => a
Prelude.mempty
                        )
            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
"NextToken")
            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 ListContributorInsights where
  hashWithSalt :: Int -> ListContributorInsights -> Int
hashWithSalt Int
_salt ListContributorInsights' {Maybe Int
Maybe Text
tableName :: Maybe Text
nextToken :: Maybe Text
maxResults :: Maybe Int
$sel:tableName:ListContributorInsights' :: ListContributorInsights -> Maybe Text
$sel:nextToken:ListContributorInsights' :: ListContributorInsights -> Maybe Text
$sel:maxResults:ListContributorInsights' :: ListContributorInsights -> Maybe Int
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Int
maxResults
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
nextToken
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
tableName

instance Prelude.NFData ListContributorInsights where
  rnf :: ListContributorInsights -> ()
rnf ListContributorInsights' {Maybe Int
Maybe Text
tableName :: Maybe Text
nextToken :: Maybe Text
maxResults :: Maybe Int
$sel:tableName:ListContributorInsights' :: ListContributorInsights -> Maybe Text
$sel:nextToken:ListContributorInsights' :: ListContributorInsights -> Maybe Text
$sel:maxResults:ListContributorInsights' :: ListContributorInsights -> Maybe Int
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Int
maxResults
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
nextToken
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
tableName

instance Data.ToHeaders ListContributorInsights where
  toHeaders :: ListContributorInsights -> 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.ListContributorInsights" ::
                          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 ListContributorInsights where
  toJSON :: ListContributorInsights -> Value
toJSON ListContributorInsights' {Maybe Int
Maybe Text
tableName :: Maybe Text
nextToken :: Maybe Text
maxResults :: Maybe Int
$sel:tableName:ListContributorInsights' :: ListContributorInsights -> Maybe Text
$sel:nextToken:ListContributorInsights' :: ListContributorInsights -> Maybe Text
$sel:maxResults:ListContributorInsights' :: ListContributorInsights -> Maybe Int
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"MaxResults" 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 Int
maxResults,
            (Key
"NextToken" 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
nextToken,
            (Key
"TableName" 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
tableName
          ]
      )

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

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

-- | /See:/ 'newListContributorInsightsResponse' smart constructor.
data ListContributorInsightsResponse = ListContributorInsightsResponse'
  { -- | A list of ContributorInsightsSummary.
    ListContributorInsightsResponse
-> Maybe [ContributorInsightsSummary]
contributorInsightsSummaries :: Prelude.Maybe [ContributorInsightsSummary],
    -- | A token to go to the next page if there is one.
    ListContributorInsightsResponse -> Maybe Text
nextToken :: Prelude.Maybe Prelude.Text,
    -- | The response's http status code.
    ListContributorInsightsResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (ListContributorInsightsResponse
-> ListContributorInsightsResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ListContributorInsightsResponse
-> ListContributorInsightsResponse -> Bool
$c/= :: ListContributorInsightsResponse
-> ListContributorInsightsResponse -> Bool
== :: ListContributorInsightsResponse
-> ListContributorInsightsResponse -> Bool
$c== :: ListContributorInsightsResponse
-> ListContributorInsightsResponse -> Bool
Prelude.Eq, ReadPrec [ListContributorInsightsResponse]
ReadPrec ListContributorInsightsResponse
Int -> ReadS ListContributorInsightsResponse
ReadS [ListContributorInsightsResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ListContributorInsightsResponse]
$creadListPrec :: ReadPrec [ListContributorInsightsResponse]
readPrec :: ReadPrec ListContributorInsightsResponse
$creadPrec :: ReadPrec ListContributorInsightsResponse
readList :: ReadS [ListContributorInsightsResponse]
$creadList :: ReadS [ListContributorInsightsResponse]
readsPrec :: Int -> ReadS ListContributorInsightsResponse
$creadsPrec :: Int -> ReadS ListContributorInsightsResponse
Prelude.Read, Int -> ListContributorInsightsResponse -> ShowS
[ListContributorInsightsResponse] -> ShowS
ListContributorInsightsResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ListContributorInsightsResponse] -> ShowS
$cshowList :: [ListContributorInsightsResponse] -> ShowS
show :: ListContributorInsightsResponse -> String
$cshow :: ListContributorInsightsResponse -> String
showsPrec :: Int -> ListContributorInsightsResponse -> ShowS
$cshowsPrec :: Int -> ListContributorInsightsResponse -> ShowS
Prelude.Show, forall x.
Rep ListContributorInsightsResponse x
-> ListContributorInsightsResponse
forall x.
ListContributorInsightsResponse
-> Rep ListContributorInsightsResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep ListContributorInsightsResponse x
-> ListContributorInsightsResponse
$cfrom :: forall x.
ListContributorInsightsResponse
-> Rep ListContributorInsightsResponse x
Prelude.Generic)

-- |
-- Create a value of 'ListContributorInsightsResponse' 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:
--
-- 'contributorInsightsSummaries', 'listContributorInsightsResponse_contributorInsightsSummaries' - A list of ContributorInsightsSummary.
--
-- 'nextToken', 'listContributorInsightsResponse_nextToken' - A token to go to the next page if there is one.
--
-- 'httpStatus', 'listContributorInsightsResponse_httpStatus' - The response's http status code.
newListContributorInsightsResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  ListContributorInsightsResponse
newListContributorInsightsResponse :: Int -> ListContributorInsightsResponse
newListContributorInsightsResponse Int
pHttpStatus_ =
  ListContributorInsightsResponse'
    { $sel:contributorInsightsSummaries:ListContributorInsightsResponse' :: Maybe [ContributorInsightsSummary]
contributorInsightsSummaries =
        forall a. Maybe a
Prelude.Nothing,
      $sel:nextToken:ListContributorInsightsResponse' :: Maybe Text
nextToken = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:ListContributorInsightsResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | A list of ContributorInsightsSummary.
listContributorInsightsResponse_contributorInsightsSummaries :: Lens.Lens' ListContributorInsightsResponse (Prelude.Maybe [ContributorInsightsSummary])
listContributorInsightsResponse_contributorInsightsSummaries :: Lens'
  ListContributorInsightsResponse
  (Maybe [ContributorInsightsSummary])
listContributorInsightsResponse_contributorInsightsSummaries = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListContributorInsightsResponse' {Maybe [ContributorInsightsSummary]
contributorInsightsSummaries :: Maybe [ContributorInsightsSummary]
$sel:contributorInsightsSummaries:ListContributorInsightsResponse' :: ListContributorInsightsResponse
-> Maybe [ContributorInsightsSummary]
contributorInsightsSummaries} -> Maybe [ContributorInsightsSummary]
contributorInsightsSummaries) (\s :: ListContributorInsightsResponse
s@ListContributorInsightsResponse' {} Maybe [ContributorInsightsSummary]
a -> ListContributorInsightsResponse
s {$sel:contributorInsightsSummaries:ListContributorInsightsResponse' :: Maybe [ContributorInsightsSummary]
contributorInsightsSummaries = Maybe [ContributorInsightsSummary]
a} :: ListContributorInsightsResponse) 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

-- | A token to go to the next page if there is one.
listContributorInsightsResponse_nextToken :: Lens.Lens' ListContributorInsightsResponse (Prelude.Maybe Prelude.Text)
listContributorInsightsResponse_nextToken :: Lens' ListContributorInsightsResponse (Maybe Text)
listContributorInsightsResponse_nextToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListContributorInsightsResponse' {Maybe Text
nextToken :: Maybe Text
$sel:nextToken:ListContributorInsightsResponse' :: ListContributorInsightsResponse -> Maybe Text
nextToken} -> Maybe Text
nextToken) (\s :: ListContributorInsightsResponse
s@ListContributorInsightsResponse' {} Maybe Text
a -> ListContributorInsightsResponse
s {$sel:nextToken:ListContributorInsightsResponse' :: Maybe Text
nextToken = Maybe Text
a} :: ListContributorInsightsResponse)

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

instance
  Prelude.NFData
    ListContributorInsightsResponse
  where
  rnf :: ListContributorInsightsResponse -> ()
rnf ListContributorInsightsResponse' {Int
Maybe [ContributorInsightsSummary]
Maybe Text
httpStatus :: Int
nextToken :: Maybe Text
contributorInsightsSummaries :: Maybe [ContributorInsightsSummary]
$sel:httpStatus:ListContributorInsightsResponse' :: ListContributorInsightsResponse -> Int
$sel:nextToken:ListContributorInsightsResponse' :: ListContributorInsightsResponse -> Maybe Text
$sel:contributorInsightsSummaries:ListContributorInsightsResponse' :: ListContributorInsightsResponse
-> Maybe [ContributorInsightsSummary]
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe [ContributorInsightsSummary]
contributorInsightsSummaries
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
nextToken
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus