{-# 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.IoT.GetBucketsAggregation
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Aggregates on indexed data with search queries pertaining to particular
-- fields.
--
-- Requires permission to access the
-- <https://docs.aws.amazon.com/service-authorization/latest/reference/list_awsiot.html#awsiot-actions-as-permissions GetBucketsAggregation>
-- action.
module Amazonka.IoT.GetBucketsAggregation
  ( -- * Creating a Request
    GetBucketsAggregation (..),
    newGetBucketsAggregation,

    -- * Request Lenses
    getBucketsAggregation_indexName,
    getBucketsAggregation_queryVersion,
    getBucketsAggregation_queryString,
    getBucketsAggregation_aggregationField,
    getBucketsAggregation_bucketsAggregationType,

    -- * Destructuring the Response
    GetBucketsAggregationResponse (..),
    newGetBucketsAggregationResponse,

    -- * Response Lenses
    getBucketsAggregationResponse_buckets,
    getBucketsAggregationResponse_totalCount,
    getBucketsAggregationResponse_httpStatus,
  )
where

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

-- | /See:/ 'newGetBucketsAggregation' smart constructor.
data GetBucketsAggregation = GetBucketsAggregation'
  { -- | The name of the index to search.
    GetBucketsAggregation -> Maybe Text
indexName :: Prelude.Maybe Prelude.Text,
    -- | The version of the query.
    GetBucketsAggregation -> Maybe Text
queryVersion :: Prelude.Maybe Prelude.Text,
    -- | The search query string.
    GetBucketsAggregation -> Text
queryString :: Prelude.Text,
    -- | The aggregation field.
    GetBucketsAggregation -> Text
aggregationField :: Prelude.Text,
    -- | The basic control of the response shape and the bucket aggregation type
    -- to perform.
    GetBucketsAggregation -> BucketsAggregationType
bucketsAggregationType :: BucketsAggregationType
  }
  deriving (GetBucketsAggregation -> GetBucketsAggregation -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetBucketsAggregation -> GetBucketsAggregation -> Bool
$c/= :: GetBucketsAggregation -> GetBucketsAggregation -> Bool
== :: GetBucketsAggregation -> GetBucketsAggregation -> Bool
$c== :: GetBucketsAggregation -> GetBucketsAggregation -> Bool
Prelude.Eq, ReadPrec [GetBucketsAggregation]
ReadPrec GetBucketsAggregation
Int -> ReadS GetBucketsAggregation
ReadS [GetBucketsAggregation]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GetBucketsAggregation]
$creadListPrec :: ReadPrec [GetBucketsAggregation]
readPrec :: ReadPrec GetBucketsAggregation
$creadPrec :: ReadPrec GetBucketsAggregation
readList :: ReadS [GetBucketsAggregation]
$creadList :: ReadS [GetBucketsAggregation]
readsPrec :: Int -> ReadS GetBucketsAggregation
$creadsPrec :: Int -> ReadS GetBucketsAggregation
Prelude.Read, Int -> GetBucketsAggregation -> ShowS
[GetBucketsAggregation] -> ShowS
GetBucketsAggregation -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetBucketsAggregation] -> ShowS
$cshowList :: [GetBucketsAggregation] -> ShowS
show :: GetBucketsAggregation -> String
$cshow :: GetBucketsAggregation -> String
showsPrec :: Int -> GetBucketsAggregation -> ShowS
$cshowsPrec :: Int -> GetBucketsAggregation -> ShowS
Prelude.Show, forall x. Rep GetBucketsAggregation x -> GetBucketsAggregation
forall x. GetBucketsAggregation -> Rep GetBucketsAggregation x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep GetBucketsAggregation x -> GetBucketsAggregation
$cfrom :: forall x. GetBucketsAggregation -> Rep GetBucketsAggregation x
Prelude.Generic)

-- |
-- Create a value of 'GetBucketsAggregation' 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', 'getBucketsAggregation_indexName' - The name of the index to search.
--
-- 'queryVersion', 'getBucketsAggregation_queryVersion' - The version of the query.
--
-- 'queryString', 'getBucketsAggregation_queryString' - The search query string.
--
-- 'aggregationField', 'getBucketsAggregation_aggregationField' - The aggregation field.
--
-- 'bucketsAggregationType', 'getBucketsAggregation_bucketsAggregationType' - The basic control of the response shape and the bucket aggregation type
-- to perform.
newGetBucketsAggregation ::
  -- | 'queryString'
  Prelude.Text ->
  -- | 'aggregationField'
  Prelude.Text ->
  -- | 'bucketsAggregationType'
  BucketsAggregationType ->
  GetBucketsAggregation
newGetBucketsAggregation :: Text -> Text -> BucketsAggregationType -> GetBucketsAggregation
newGetBucketsAggregation
  Text
pQueryString_
  Text
pAggregationField_
  BucketsAggregationType
pBucketsAggregationType_ =
    GetBucketsAggregation'
      { $sel:indexName:GetBucketsAggregation' :: Maybe Text
indexName = forall a. Maybe a
Prelude.Nothing,
        $sel:queryVersion:GetBucketsAggregation' :: Maybe Text
queryVersion = forall a. Maybe a
Prelude.Nothing,
        $sel:queryString:GetBucketsAggregation' :: Text
queryString = Text
pQueryString_,
        $sel:aggregationField:GetBucketsAggregation' :: Text
aggregationField = Text
pAggregationField_,
        $sel:bucketsAggregationType:GetBucketsAggregation' :: BucketsAggregationType
bucketsAggregationType = BucketsAggregationType
pBucketsAggregationType_
      }

-- | The name of the index to search.
getBucketsAggregation_indexName :: Lens.Lens' GetBucketsAggregation (Prelude.Maybe Prelude.Text)
getBucketsAggregation_indexName :: Lens' GetBucketsAggregation (Maybe Text)
getBucketsAggregation_indexName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetBucketsAggregation' {Maybe Text
indexName :: Maybe Text
$sel:indexName:GetBucketsAggregation' :: GetBucketsAggregation -> Maybe Text
indexName} -> Maybe Text
indexName) (\s :: GetBucketsAggregation
s@GetBucketsAggregation' {} Maybe Text
a -> GetBucketsAggregation
s {$sel:indexName:GetBucketsAggregation' :: Maybe Text
indexName = Maybe Text
a} :: GetBucketsAggregation)

-- | The version of the query.
getBucketsAggregation_queryVersion :: Lens.Lens' GetBucketsAggregation (Prelude.Maybe Prelude.Text)
getBucketsAggregation_queryVersion :: Lens' GetBucketsAggregation (Maybe Text)
getBucketsAggregation_queryVersion = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetBucketsAggregation' {Maybe Text
queryVersion :: Maybe Text
$sel:queryVersion:GetBucketsAggregation' :: GetBucketsAggregation -> Maybe Text
queryVersion} -> Maybe Text
queryVersion) (\s :: GetBucketsAggregation
s@GetBucketsAggregation' {} Maybe Text
a -> GetBucketsAggregation
s {$sel:queryVersion:GetBucketsAggregation' :: Maybe Text
queryVersion = Maybe Text
a} :: GetBucketsAggregation)

-- | The search query string.
getBucketsAggregation_queryString :: Lens.Lens' GetBucketsAggregation Prelude.Text
getBucketsAggregation_queryString :: Lens' GetBucketsAggregation Text
getBucketsAggregation_queryString = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetBucketsAggregation' {Text
queryString :: Text
$sel:queryString:GetBucketsAggregation' :: GetBucketsAggregation -> Text
queryString} -> Text
queryString) (\s :: GetBucketsAggregation
s@GetBucketsAggregation' {} Text
a -> GetBucketsAggregation
s {$sel:queryString:GetBucketsAggregation' :: Text
queryString = Text
a} :: GetBucketsAggregation)

-- | The aggregation field.
getBucketsAggregation_aggregationField :: Lens.Lens' GetBucketsAggregation Prelude.Text
getBucketsAggregation_aggregationField :: Lens' GetBucketsAggregation Text
getBucketsAggregation_aggregationField = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetBucketsAggregation' {Text
aggregationField :: Text
$sel:aggregationField:GetBucketsAggregation' :: GetBucketsAggregation -> Text
aggregationField} -> Text
aggregationField) (\s :: GetBucketsAggregation
s@GetBucketsAggregation' {} Text
a -> GetBucketsAggregation
s {$sel:aggregationField:GetBucketsAggregation' :: Text
aggregationField = Text
a} :: GetBucketsAggregation)

-- | The basic control of the response shape and the bucket aggregation type
-- to perform.
getBucketsAggregation_bucketsAggregationType :: Lens.Lens' GetBucketsAggregation BucketsAggregationType
getBucketsAggregation_bucketsAggregationType :: Lens' GetBucketsAggregation BucketsAggregationType
getBucketsAggregation_bucketsAggregationType = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetBucketsAggregation' {BucketsAggregationType
bucketsAggregationType :: BucketsAggregationType
$sel:bucketsAggregationType:GetBucketsAggregation' :: GetBucketsAggregation -> BucketsAggregationType
bucketsAggregationType} -> BucketsAggregationType
bucketsAggregationType) (\s :: GetBucketsAggregation
s@GetBucketsAggregation' {} BucketsAggregationType
a -> GetBucketsAggregation
s {$sel:bucketsAggregationType:GetBucketsAggregation' :: BucketsAggregationType
bucketsAggregationType = BucketsAggregationType
a} :: GetBucketsAggregation)

instance Core.AWSRequest GetBucketsAggregation where
  type
    AWSResponse GetBucketsAggregation =
      GetBucketsAggregationResponse
  request :: (Service -> Service)
-> GetBucketsAggregation -> Request GetBucketsAggregation
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 GetBucketsAggregation
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse GetBucketsAggregation)))
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 [Bucket] -> Maybe Int -> Int -> GetBucketsAggregationResponse
GetBucketsAggregationResponse'
            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
"buckets" 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
"totalCount")
            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 GetBucketsAggregation where
  hashWithSalt :: Int -> GetBucketsAggregation -> Int
hashWithSalt Int
_salt GetBucketsAggregation' {Maybe Text
Text
BucketsAggregationType
bucketsAggregationType :: BucketsAggregationType
aggregationField :: Text
queryString :: Text
queryVersion :: Maybe Text
indexName :: Maybe Text
$sel:bucketsAggregationType:GetBucketsAggregation' :: GetBucketsAggregation -> BucketsAggregationType
$sel:aggregationField:GetBucketsAggregation' :: GetBucketsAggregation -> Text
$sel:queryString:GetBucketsAggregation' :: GetBucketsAggregation -> Text
$sel:queryVersion:GetBucketsAggregation' :: GetBucketsAggregation -> Maybe Text
$sel:indexName:GetBucketsAggregation' :: GetBucketsAggregation -> 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` Maybe Text
queryVersion
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
queryString
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
aggregationField
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` BucketsAggregationType
bucketsAggregationType

instance Prelude.NFData GetBucketsAggregation where
  rnf :: GetBucketsAggregation -> ()
rnf GetBucketsAggregation' {Maybe Text
Text
BucketsAggregationType
bucketsAggregationType :: BucketsAggregationType
aggregationField :: Text
queryString :: Text
queryVersion :: Maybe Text
indexName :: Maybe Text
$sel:bucketsAggregationType:GetBucketsAggregation' :: GetBucketsAggregation -> BucketsAggregationType
$sel:aggregationField:GetBucketsAggregation' :: GetBucketsAggregation -> Text
$sel:queryString:GetBucketsAggregation' :: GetBucketsAggregation -> Text
$sel:queryVersion:GetBucketsAggregation' :: GetBucketsAggregation -> Maybe Text
$sel:indexName:GetBucketsAggregation' :: GetBucketsAggregation -> 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 Maybe Text
queryVersion
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
queryString
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
aggregationField
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf BucketsAggregationType
bucketsAggregationType

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

instance Data.ToJSON GetBucketsAggregation where
  toJSON :: GetBucketsAggregation -> Value
toJSON GetBucketsAggregation' {Maybe Text
Text
BucketsAggregationType
bucketsAggregationType :: BucketsAggregationType
aggregationField :: Text
queryString :: Text
queryVersion :: Maybe Text
indexName :: Maybe Text
$sel:bucketsAggregationType:GetBucketsAggregation' :: GetBucketsAggregation -> BucketsAggregationType
$sel:aggregationField:GetBucketsAggregation' :: GetBucketsAggregation -> Text
$sel:queryString:GetBucketsAggregation' :: GetBucketsAggregation -> Text
$sel:queryVersion:GetBucketsAggregation' :: GetBucketsAggregation -> Maybe Text
$sel:indexName:GetBucketsAggregation' :: GetBucketsAggregation -> 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,
            (Key
"queryVersion" 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
queryVersion,
            forall a. a -> Maybe a
Prelude.Just (Key
"queryString" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
queryString),
            forall a. a -> Maybe a
Prelude.Just
              (Key
"aggregationField" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
aggregationField),
            forall a. a -> Maybe a
Prelude.Just
              ( Key
"bucketsAggregationType"
                  forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= BucketsAggregationType
bucketsAggregationType
              )
          ]
      )

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

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

-- | /See:/ 'newGetBucketsAggregationResponse' smart constructor.
data GetBucketsAggregationResponse = GetBucketsAggregationResponse'
  { -- | The main part of the response with a list of buckets. Each bucket
    -- contains a @keyValue@ and a @count@.
    --
    -- @keyValue@: The aggregation field value counted for the particular
    -- bucket.
    --
    -- @count@: The number of documents that have that value.
    GetBucketsAggregationResponse -> Maybe [Bucket]
buckets :: Prelude.Maybe [Bucket],
    -- | The total number of things that fit the query string criteria.
    GetBucketsAggregationResponse -> Maybe Int
totalCount :: Prelude.Maybe Prelude.Int,
    -- | The response's http status code.
    GetBucketsAggregationResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (GetBucketsAggregationResponse
-> GetBucketsAggregationResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetBucketsAggregationResponse
-> GetBucketsAggregationResponse -> Bool
$c/= :: GetBucketsAggregationResponse
-> GetBucketsAggregationResponse -> Bool
== :: GetBucketsAggregationResponse
-> GetBucketsAggregationResponse -> Bool
$c== :: GetBucketsAggregationResponse
-> GetBucketsAggregationResponse -> Bool
Prelude.Eq, ReadPrec [GetBucketsAggregationResponse]
ReadPrec GetBucketsAggregationResponse
Int -> ReadS GetBucketsAggregationResponse
ReadS [GetBucketsAggregationResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GetBucketsAggregationResponse]
$creadListPrec :: ReadPrec [GetBucketsAggregationResponse]
readPrec :: ReadPrec GetBucketsAggregationResponse
$creadPrec :: ReadPrec GetBucketsAggregationResponse
readList :: ReadS [GetBucketsAggregationResponse]
$creadList :: ReadS [GetBucketsAggregationResponse]
readsPrec :: Int -> ReadS GetBucketsAggregationResponse
$creadsPrec :: Int -> ReadS GetBucketsAggregationResponse
Prelude.Read, Int -> GetBucketsAggregationResponse -> ShowS
[GetBucketsAggregationResponse] -> ShowS
GetBucketsAggregationResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetBucketsAggregationResponse] -> ShowS
$cshowList :: [GetBucketsAggregationResponse] -> ShowS
show :: GetBucketsAggregationResponse -> String
$cshow :: GetBucketsAggregationResponse -> String
showsPrec :: Int -> GetBucketsAggregationResponse -> ShowS
$cshowsPrec :: Int -> GetBucketsAggregationResponse -> ShowS
Prelude.Show, forall x.
Rep GetBucketsAggregationResponse x
-> GetBucketsAggregationResponse
forall x.
GetBucketsAggregationResponse
-> Rep GetBucketsAggregationResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep GetBucketsAggregationResponse x
-> GetBucketsAggregationResponse
$cfrom :: forall x.
GetBucketsAggregationResponse
-> Rep GetBucketsAggregationResponse x
Prelude.Generic)

-- |
-- Create a value of 'GetBucketsAggregationResponse' 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:
--
-- 'buckets', 'getBucketsAggregationResponse_buckets' - The main part of the response with a list of buckets. Each bucket
-- contains a @keyValue@ and a @count@.
--
-- @keyValue@: The aggregation field value counted for the particular
-- bucket.
--
-- @count@: The number of documents that have that value.
--
-- 'totalCount', 'getBucketsAggregationResponse_totalCount' - The total number of things that fit the query string criteria.
--
-- 'httpStatus', 'getBucketsAggregationResponse_httpStatus' - The response's http status code.
newGetBucketsAggregationResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  GetBucketsAggregationResponse
newGetBucketsAggregationResponse :: Int -> GetBucketsAggregationResponse
newGetBucketsAggregationResponse Int
pHttpStatus_ =
  GetBucketsAggregationResponse'
    { $sel:buckets:GetBucketsAggregationResponse' :: Maybe [Bucket]
buckets =
        forall a. Maybe a
Prelude.Nothing,
      $sel:totalCount:GetBucketsAggregationResponse' :: Maybe Int
totalCount = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:GetBucketsAggregationResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | The main part of the response with a list of buckets. Each bucket
-- contains a @keyValue@ and a @count@.
--
-- @keyValue@: The aggregation field value counted for the particular
-- bucket.
--
-- @count@: The number of documents that have that value.
getBucketsAggregationResponse_buckets :: Lens.Lens' GetBucketsAggregationResponse (Prelude.Maybe [Bucket])
getBucketsAggregationResponse_buckets :: Lens' GetBucketsAggregationResponse (Maybe [Bucket])
getBucketsAggregationResponse_buckets = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetBucketsAggregationResponse' {Maybe [Bucket]
buckets :: Maybe [Bucket]
$sel:buckets:GetBucketsAggregationResponse' :: GetBucketsAggregationResponse -> Maybe [Bucket]
buckets} -> Maybe [Bucket]
buckets) (\s :: GetBucketsAggregationResponse
s@GetBucketsAggregationResponse' {} Maybe [Bucket]
a -> GetBucketsAggregationResponse
s {$sel:buckets:GetBucketsAggregationResponse' :: Maybe [Bucket]
buckets = Maybe [Bucket]
a} :: GetBucketsAggregationResponse) 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 total number of things that fit the query string criteria.
getBucketsAggregationResponse_totalCount :: Lens.Lens' GetBucketsAggregationResponse (Prelude.Maybe Prelude.Int)
getBucketsAggregationResponse_totalCount :: Lens' GetBucketsAggregationResponse (Maybe Int)
getBucketsAggregationResponse_totalCount = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetBucketsAggregationResponse' {Maybe Int
totalCount :: Maybe Int
$sel:totalCount:GetBucketsAggregationResponse' :: GetBucketsAggregationResponse -> Maybe Int
totalCount} -> Maybe Int
totalCount) (\s :: GetBucketsAggregationResponse
s@GetBucketsAggregationResponse' {} Maybe Int
a -> GetBucketsAggregationResponse
s {$sel:totalCount:GetBucketsAggregationResponse' :: Maybe Int
totalCount = Maybe Int
a} :: GetBucketsAggregationResponse)

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

instance Prelude.NFData GetBucketsAggregationResponse where
  rnf :: GetBucketsAggregationResponse -> ()
rnf GetBucketsAggregationResponse' {Int
Maybe Int
Maybe [Bucket]
httpStatus :: Int
totalCount :: Maybe Int
buckets :: Maybe [Bucket]
$sel:httpStatus:GetBucketsAggregationResponse' :: GetBucketsAggregationResponse -> Int
$sel:totalCount:GetBucketsAggregationResponse' :: GetBucketsAggregationResponse -> Maybe Int
$sel:buckets:GetBucketsAggregationResponse' :: GetBucketsAggregationResponse -> Maybe [Bucket]
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe [Bucket]
buckets
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Int
totalCount
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus