{-# 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.AWSHealth.DescribeEventAggregates
-- 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 the number of events of each event type (issue, scheduled
-- change, and account notification). If no filter is specified, the counts
-- of all events in each category are returned.
--
-- This API operation uses pagination. Specify the @nextToken@ parameter in
-- the next request to return more results.
--
-- This operation returns paginated results.
module Amazonka.AWSHealth.DescribeEventAggregates
  ( -- * Creating a Request
    DescribeEventAggregates (..),
    newDescribeEventAggregates,

    -- * Request Lenses
    describeEventAggregates_filter,
    describeEventAggregates_maxResults,
    describeEventAggregates_nextToken,
    describeEventAggregates_aggregateField,

    -- * Destructuring the Response
    DescribeEventAggregatesResponse (..),
    newDescribeEventAggregatesResponse,

    -- * Response Lenses
    describeEventAggregatesResponse_eventAggregates,
    describeEventAggregatesResponse_nextToken,
    describeEventAggregatesResponse_httpStatus,
  )
where

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

-- | /See:/ 'newDescribeEventAggregates' smart constructor.
data DescribeEventAggregates = DescribeEventAggregates'
  { -- | Values to narrow the results returned.
    DescribeEventAggregates -> Maybe EventFilter
filter' :: Prelude.Maybe EventFilter,
    -- | The maximum number of items to return in one batch, between 10 and 100,
    -- inclusive.
    DescribeEventAggregates -> Maybe Natural
maxResults :: Prelude.Maybe Prelude.Natural,
    -- | If the results of a search are large, only a portion of the results are
    -- returned, and a @nextToken@ pagination token is returned in the
    -- response. To retrieve the next batch of results, reissue the search
    -- request and include the returned token. When all results have been
    -- returned, the response does not contain a pagination token value.
    DescribeEventAggregates -> Maybe Text
nextToken :: Prelude.Maybe Prelude.Text,
    -- | The only currently supported value is @eventTypeCategory@.
    DescribeEventAggregates -> EventAggregateField
aggregateField :: EventAggregateField
  }
  deriving (DescribeEventAggregates -> DescribeEventAggregates -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DescribeEventAggregates -> DescribeEventAggregates -> Bool
$c/= :: DescribeEventAggregates -> DescribeEventAggregates -> Bool
== :: DescribeEventAggregates -> DescribeEventAggregates -> Bool
$c== :: DescribeEventAggregates -> DescribeEventAggregates -> Bool
Prelude.Eq, ReadPrec [DescribeEventAggregates]
ReadPrec DescribeEventAggregates
Int -> ReadS DescribeEventAggregates
ReadS [DescribeEventAggregates]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DescribeEventAggregates]
$creadListPrec :: ReadPrec [DescribeEventAggregates]
readPrec :: ReadPrec DescribeEventAggregates
$creadPrec :: ReadPrec DescribeEventAggregates
readList :: ReadS [DescribeEventAggregates]
$creadList :: ReadS [DescribeEventAggregates]
readsPrec :: Int -> ReadS DescribeEventAggregates
$creadsPrec :: Int -> ReadS DescribeEventAggregates
Prelude.Read, Int -> DescribeEventAggregates -> ShowS
[DescribeEventAggregates] -> ShowS
DescribeEventAggregates -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DescribeEventAggregates] -> ShowS
$cshowList :: [DescribeEventAggregates] -> ShowS
show :: DescribeEventAggregates -> String
$cshow :: DescribeEventAggregates -> String
showsPrec :: Int -> DescribeEventAggregates -> ShowS
$cshowsPrec :: Int -> DescribeEventAggregates -> ShowS
Prelude.Show, forall x. Rep DescribeEventAggregates x -> DescribeEventAggregates
forall x. DescribeEventAggregates -> Rep DescribeEventAggregates x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep DescribeEventAggregates x -> DescribeEventAggregates
$cfrom :: forall x. DescribeEventAggregates -> Rep DescribeEventAggregates x
Prelude.Generic)

-- |
-- Create a value of 'DescribeEventAggregates' 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:
--
-- 'filter'', 'describeEventAggregates_filter' - Values to narrow the results returned.
--
-- 'maxResults', 'describeEventAggregates_maxResults' - The maximum number of items to return in one batch, between 10 and 100,
-- inclusive.
--
-- 'nextToken', 'describeEventAggregates_nextToken' - If the results of a search are large, only a portion of the results are
-- returned, and a @nextToken@ pagination token is returned in the
-- response. To retrieve the next batch of results, reissue the search
-- request and include the returned token. When all results have been
-- returned, the response does not contain a pagination token value.
--
-- 'aggregateField', 'describeEventAggregates_aggregateField' - The only currently supported value is @eventTypeCategory@.
newDescribeEventAggregates ::
  -- | 'aggregateField'
  EventAggregateField ->
  DescribeEventAggregates
newDescribeEventAggregates :: EventAggregateField -> DescribeEventAggregates
newDescribeEventAggregates EventAggregateField
pAggregateField_ =
  DescribeEventAggregates'
    { $sel:filter':DescribeEventAggregates' :: Maybe EventFilter
filter' = forall a. Maybe a
Prelude.Nothing,
      $sel:maxResults:DescribeEventAggregates' :: Maybe Natural
maxResults = forall a. Maybe a
Prelude.Nothing,
      $sel:nextToken:DescribeEventAggregates' :: Maybe Text
nextToken = forall a. Maybe a
Prelude.Nothing,
      $sel:aggregateField:DescribeEventAggregates' :: EventAggregateField
aggregateField = EventAggregateField
pAggregateField_
    }

-- | Values to narrow the results returned.
describeEventAggregates_filter :: Lens.Lens' DescribeEventAggregates (Prelude.Maybe EventFilter)
describeEventAggregates_filter :: Lens' DescribeEventAggregates (Maybe EventFilter)
describeEventAggregates_filter = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeEventAggregates' {Maybe EventFilter
filter' :: Maybe EventFilter
$sel:filter':DescribeEventAggregates' :: DescribeEventAggregates -> Maybe EventFilter
filter'} -> Maybe EventFilter
filter') (\s :: DescribeEventAggregates
s@DescribeEventAggregates' {} Maybe EventFilter
a -> DescribeEventAggregates
s {$sel:filter':DescribeEventAggregates' :: Maybe EventFilter
filter' = Maybe EventFilter
a} :: DescribeEventAggregates)

-- | The maximum number of items to return in one batch, between 10 and 100,
-- inclusive.
describeEventAggregates_maxResults :: Lens.Lens' DescribeEventAggregates (Prelude.Maybe Prelude.Natural)
describeEventAggregates_maxResults :: Lens' DescribeEventAggregates (Maybe Natural)
describeEventAggregates_maxResults = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeEventAggregates' {Maybe Natural
maxResults :: Maybe Natural
$sel:maxResults:DescribeEventAggregates' :: DescribeEventAggregates -> Maybe Natural
maxResults} -> Maybe Natural
maxResults) (\s :: DescribeEventAggregates
s@DescribeEventAggregates' {} Maybe Natural
a -> DescribeEventAggregates
s {$sel:maxResults:DescribeEventAggregates' :: Maybe Natural
maxResults = Maybe Natural
a} :: DescribeEventAggregates)

-- | If the results of a search are large, only a portion of the results are
-- returned, and a @nextToken@ pagination token is returned in the
-- response. To retrieve the next batch of results, reissue the search
-- request and include the returned token. When all results have been
-- returned, the response does not contain a pagination token value.
describeEventAggregates_nextToken :: Lens.Lens' DescribeEventAggregates (Prelude.Maybe Prelude.Text)
describeEventAggregates_nextToken :: Lens' DescribeEventAggregates (Maybe Text)
describeEventAggregates_nextToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeEventAggregates' {Maybe Text
nextToken :: Maybe Text
$sel:nextToken:DescribeEventAggregates' :: DescribeEventAggregates -> Maybe Text
nextToken} -> Maybe Text
nextToken) (\s :: DescribeEventAggregates
s@DescribeEventAggregates' {} Maybe Text
a -> DescribeEventAggregates
s {$sel:nextToken:DescribeEventAggregates' :: Maybe Text
nextToken = Maybe Text
a} :: DescribeEventAggregates)

-- | The only currently supported value is @eventTypeCategory@.
describeEventAggregates_aggregateField :: Lens.Lens' DescribeEventAggregates EventAggregateField
describeEventAggregates_aggregateField :: Lens' DescribeEventAggregates EventAggregateField
describeEventAggregates_aggregateField = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeEventAggregates' {EventAggregateField
aggregateField :: EventAggregateField
$sel:aggregateField:DescribeEventAggregates' :: DescribeEventAggregates -> EventAggregateField
aggregateField} -> EventAggregateField
aggregateField) (\s :: DescribeEventAggregates
s@DescribeEventAggregates' {} EventAggregateField
a -> DescribeEventAggregates
s {$sel:aggregateField:DescribeEventAggregates' :: EventAggregateField
aggregateField = EventAggregateField
a} :: DescribeEventAggregates)

instance Core.AWSPager DescribeEventAggregates where
  page :: DescribeEventAggregates
-> AWSResponse DescribeEventAggregates
-> Maybe DescribeEventAggregates
page DescribeEventAggregates
rq AWSResponse DescribeEventAggregates
rs
    | forall a. AWSTruncated a => a -> Bool
Core.stop
        ( AWSResponse DescribeEventAggregates
rs
            forall s a. s -> Getting (First a) s a -> Maybe a
Lens.^? Lens' DescribeEventAggregatesResponse (Maybe Text)
describeEventAggregatesResponse_nextToken
            forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall a b. Prism (Maybe a) (Maybe b) a b
Lens._Just
        ) =
        forall a. Maybe a
Prelude.Nothing
    | forall a. AWSTruncated a => a -> Bool
Core.stop
        ( AWSResponse DescribeEventAggregates
rs
            forall s a. s -> Getting (First a) s a -> Maybe a
Lens.^? Lens' DescribeEventAggregatesResponse (Maybe [EventAggregate])
describeEventAggregatesResponse_eventAggregates
            forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall a b. Prism (Maybe a) (Maybe b) a b
Lens._Just
        ) =
        forall a. Maybe a
Prelude.Nothing
    | Bool
Prelude.otherwise =
        forall a. a -> Maybe a
Prelude.Just
          forall a b. (a -> b) -> a -> b
Prelude.$ DescribeEventAggregates
rq
          forall a b. a -> (a -> b) -> b
Prelude.& Lens' DescribeEventAggregates (Maybe Text)
describeEventAggregates_nextToken
          forall s t a b. ASetter s t a b -> b -> s -> t
Lens..~ AWSResponse DescribeEventAggregates
rs
          forall s a. s -> Getting (First a) s a -> Maybe a
Lens.^? Lens' DescribeEventAggregatesResponse (Maybe Text)
describeEventAggregatesResponse_nextToken
          forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall a b. Prism (Maybe a) (Maybe b) a b
Lens._Just

instance Core.AWSRequest DescribeEventAggregates where
  type
    AWSResponse DescribeEventAggregates =
      DescribeEventAggregatesResponse
  request :: (Service -> Service)
-> DescribeEventAggregates -> Request DescribeEventAggregates
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 DescribeEventAggregates
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse DescribeEventAggregates)))
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 [EventAggregate]
-> Maybe Text -> Int -> DescribeEventAggregatesResponse
DescribeEventAggregatesResponse'
            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
"eventAggregates"
                            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 DescribeEventAggregates where
  hashWithSalt :: Int -> DescribeEventAggregates -> Int
hashWithSalt Int
_salt DescribeEventAggregates' {Maybe Natural
Maybe Text
Maybe EventFilter
EventAggregateField
aggregateField :: EventAggregateField
nextToken :: Maybe Text
maxResults :: Maybe Natural
filter' :: Maybe EventFilter
$sel:aggregateField:DescribeEventAggregates' :: DescribeEventAggregates -> EventAggregateField
$sel:nextToken:DescribeEventAggregates' :: DescribeEventAggregates -> Maybe Text
$sel:maxResults:DescribeEventAggregates' :: DescribeEventAggregates -> Maybe Natural
$sel:filter':DescribeEventAggregates' :: DescribeEventAggregates -> Maybe EventFilter
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe EventFilter
filter'
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Natural
maxResults
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
nextToken
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` EventAggregateField
aggregateField

instance Prelude.NFData DescribeEventAggregates where
  rnf :: DescribeEventAggregates -> ()
rnf DescribeEventAggregates' {Maybe Natural
Maybe Text
Maybe EventFilter
EventAggregateField
aggregateField :: EventAggregateField
nextToken :: Maybe Text
maxResults :: Maybe Natural
filter' :: Maybe EventFilter
$sel:aggregateField:DescribeEventAggregates' :: DescribeEventAggregates -> EventAggregateField
$sel:nextToken:DescribeEventAggregates' :: DescribeEventAggregates -> Maybe Text
$sel:maxResults:DescribeEventAggregates' :: DescribeEventAggregates -> Maybe Natural
$sel:filter':DescribeEventAggregates' :: DescribeEventAggregates -> Maybe EventFilter
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe EventFilter
filter'
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Natural
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 EventAggregateField
aggregateField

instance Data.ToHeaders DescribeEventAggregates where
  toHeaders :: DescribeEventAggregates -> 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
"AWSHealth_20160804.DescribeEventAggregates" ::
                          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 DescribeEventAggregates where
  toJSON :: DescribeEventAggregates -> Value
toJSON DescribeEventAggregates' {Maybe Natural
Maybe Text
Maybe EventFilter
EventAggregateField
aggregateField :: EventAggregateField
nextToken :: Maybe Text
maxResults :: Maybe Natural
filter' :: Maybe EventFilter
$sel:aggregateField:DescribeEventAggregates' :: DescribeEventAggregates -> EventAggregateField
$sel:nextToken:DescribeEventAggregates' :: DescribeEventAggregates -> Maybe Text
$sel:maxResults:DescribeEventAggregates' :: DescribeEventAggregates -> Maybe Natural
$sel:filter':DescribeEventAggregates' :: DescribeEventAggregates -> Maybe EventFilter
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"filter" 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 EventFilter
filter',
            (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 Natural
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,
            forall a. a -> Maybe a
Prelude.Just
              (Key
"aggregateField" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= EventAggregateField
aggregateField)
          ]
      )

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

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

-- | /See:/ 'newDescribeEventAggregatesResponse' smart constructor.
data DescribeEventAggregatesResponse = DescribeEventAggregatesResponse'
  { -- | The number of events in each category that meet the optional filter
    -- criteria.
    DescribeEventAggregatesResponse -> Maybe [EventAggregate]
eventAggregates :: Prelude.Maybe [EventAggregate],
    -- | If the results of a search are large, only a portion of the results are
    -- returned, and a @nextToken@ pagination token is returned in the
    -- response. To retrieve the next batch of results, reissue the search
    -- request and include the returned token. When all results have been
    -- returned, the response does not contain a pagination token value.
    DescribeEventAggregatesResponse -> Maybe Text
nextToken :: Prelude.Maybe Prelude.Text,
    -- | The response's http status code.
    DescribeEventAggregatesResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (DescribeEventAggregatesResponse
-> DescribeEventAggregatesResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DescribeEventAggregatesResponse
-> DescribeEventAggregatesResponse -> Bool
$c/= :: DescribeEventAggregatesResponse
-> DescribeEventAggregatesResponse -> Bool
== :: DescribeEventAggregatesResponse
-> DescribeEventAggregatesResponse -> Bool
$c== :: DescribeEventAggregatesResponse
-> DescribeEventAggregatesResponse -> Bool
Prelude.Eq, ReadPrec [DescribeEventAggregatesResponse]
ReadPrec DescribeEventAggregatesResponse
Int -> ReadS DescribeEventAggregatesResponse
ReadS [DescribeEventAggregatesResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DescribeEventAggregatesResponse]
$creadListPrec :: ReadPrec [DescribeEventAggregatesResponse]
readPrec :: ReadPrec DescribeEventAggregatesResponse
$creadPrec :: ReadPrec DescribeEventAggregatesResponse
readList :: ReadS [DescribeEventAggregatesResponse]
$creadList :: ReadS [DescribeEventAggregatesResponse]
readsPrec :: Int -> ReadS DescribeEventAggregatesResponse
$creadsPrec :: Int -> ReadS DescribeEventAggregatesResponse
Prelude.Read, Int -> DescribeEventAggregatesResponse -> ShowS
[DescribeEventAggregatesResponse] -> ShowS
DescribeEventAggregatesResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DescribeEventAggregatesResponse] -> ShowS
$cshowList :: [DescribeEventAggregatesResponse] -> ShowS
show :: DescribeEventAggregatesResponse -> String
$cshow :: DescribeEventAggregatesResponse -> String
showsPrec :: Int -> DescribeEventAggregatesResponse -> ShowS
$cshowsPrec :: Int -> DescribeEventAggregatesResponse -> ShowS
Prelude.Show, forall x.
Rep DescribeEventAggregatesResponse x
-> DescribeEventAggregatesResponse
forall x.
DescribeEventAggregatesResponse
-> Rep DescribeEventAggregatesResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep DescribeEventAggregatesResponse x
-> DescribeEventAggregatesResponse
$cfrom :: forall x.
DescribeEventAggregatesResponse
-> Rep DescribeEventAggregatesResponse x
Prelude.Generic)

-- |
-- Create a value of 'DescribeEventAggregatesResponse' 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:
--
-- 'eventAggregates', 'describeEventAggregatesResponse_eventAggregates' - The number of events in each category that meet the optional filter
-- criteria.
--
-- 'nextToken', 'describeEventAggregatesResponse_nextToken' - If the results of a search are large, only a portion of the results are
-- returned, and a @nextToken@ pagination token is returned in the
-- response. To retrieve the next batch of results, reissue the search
-- request and include the returned token. When all results have been
-- returned, the response does not contain a pagination token value.
--
-- 'httpStatus', 'describeEventAggregatesResponse_httpStatus' - The response's http status code.
newDescribeEventAggregatesResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  DescribeEventAggregatesResponse
newDescribeEventAggregatesResponse :: Int -> DescribeEventAggregatesResponse
newDescribeEventAggregatesResponse Int
pHttpStatus_ =
  DescribeEventAggregatesResponse'
    { $sel:eventAggregates:DescribeEventAggregatesResponse' :: Maybe [EventAggregate]
eventAggregates =
        forall a. Maybe a
Prelude.Nothing,
      $sel:nextToken:DescribeEventAggregatesResponse' :: Maybe Text
nextToken = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:DescribeEventAggregatesResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | The number of events in each category that meet the optional filter
-- criteria.
describeEventAggregatesResponse_eventAggregates :: Lens.Lens' DescribeEventAggregatesResponse (Prelude.Maybe [EventAggregate])
describeEventAggregatesResponse_eventAggregates :: Lens' DescribeEventAggregatesResponse (Maybe [EventAggregate])
describeEventAggregatesResponse_eventAggregates = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeEventAggregatesResponse' {Maybe [EventAggregate]
eventAggregates :: Maybe [EventAggregate]
$sel:eventAggregates:DescribeEventAggregatesResponse' :: DescribeEventAggregatesResponse -> Maybe [EventAggregate]
eventAggregates} -> Maybe [EventAggregate]
eventAggregates) (\s :: DescribeEventAggregatesResponse
s@DescribeEventAggregatesResponse' {} Maybe [EventAggregate]
a -> DescribeEventAggregatesResponse
s {$sel:eventAggregates:DescribeEventAggregatesResponse' :: Maybe [EventAggregate]
eventAggregates = Maybe [EventAggregate]
a} :: DescribeEventAggregatesResponse) 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

-- | If the results of a search are large, only a portion of the results are
-- returned, and a @nextToken@ pagination token is returned in the
-- response. To retrieve the next batch of results, reissue the search
-- request and include the returned token. When all results have been
-- returned, the response does not contain a pagination token value.
describeEventAggregatesResponse_nextToken :: Lens.Lens' DescribeEventAggregatesResponse (Prelude.Maybe Prelude.Text)
describeEventAggregatesResponse_nextToken :: Lens' DescribeEventAggregatesResponse (Maybe Text)
describeEventAggregatesResponse_nextToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeEventAggregatesResponse' {Maybe Text
nextToken :: Maybe Text
$sel:nextToken:DescribeEventAggregatesResponse' :: DescribeEventAggregatesResponse -> Maybe Text
nextToken} -> Maybe Text
nextToken) (\s :: DescribeEventAggregatesResponse
s@DescribeEventAggregatesResponse' {} Maybe Text
a -> DescribeEventAggregatesResponse
s {$sel:nextToken:DescribeEventAggregatesResponse' :: Maybe Text
nextToken = Maybe Text
a} :: DescribeEventAggregatesResponse)

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

instance
  Prelude.NFData
    DescribeEventAggregatesResponse
  where
  rnf :: DescribeEventAggregatesResponse -> ()
rnf DescribeEventAggregatesResponse' {Int
Maybe [EventAggregate]
Maybe Text
httpStatus :: Int
nextToken :: Maybe Text
eventAggregates :: Maybe [EventAggregate]
$sel:httpStatus:DescribeEventAggregatesResponse' :: DescribeEventAggregatesResponse -> Int
$sel:nextToken:DescribeEventAggregatesResponse' :: DescribeEventAggregatesResponse -> Maybe Text
$sel:eventAggregates:DescribeEventAggregatesResponse' :: DescribeEventAggregatesResponse -> Maybe [EventAggregate]
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe [EventAggregate]
eventAggregates
      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