{-# 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.DescribeEventDetails
-- 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 detailed information about one or more specified events.
-- Information includes standard event data (Amazon Web Services Region,
-- service, and so on, as returned by
-- <https://docs.aws.amazon.com/health/latest/APIReference/API_DescribeEvents.html DescribeEvents>),
-- a detailed event description, and possible additional metadata that
-- depends upon the nature of the event. Affected entities are not
-- included. To retrieve the entities, use the
-- <https://docs.aws.amazon.com/health/latest/APIReference/API_DescribeAffectedEntities.html DescribeAffectedEntities>
-- operation.
--
-- If a specified event can\'t be retrieved, an error message is returned
-- for that event.
--
-- This operation supports resource-level permissions. You can use this
-- operation to allow or deny access to specific Health events. For more
-- information, see
-- <https://docs.aws.amazon.com/health/latest/ug/security_iam_id-based-policy-examples.html#resource-action-based-conditions Resource- and action-based conditions>
-- in the /Health User Guide/.
module Amazonka.AWSHealth.DescribeEventDetails
  ( -- * Creating a Request
    DescribeEventDetails (..),
    newDescribeEventDetails,

    -- * Request Lenses
    describeEventDetails_locale,
    describeEventDetails_eventArns,

    -- * Destructuring the Response
    DescribeEventDetailsResponse (..),
    newDescribeEventDetailsResponse,

    -- * Response Lenses
    describeEventDetailsResponse_failedSet,
    describeEventDetailsResponse_successfulSet,
    describeEventDetailsResponse_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:/ 'newDescribeEventDetails' smart constructor.
data DescribeEventDetails = DescribeEventDetails'
  { -- | The locale (language) to return information in. English (en) is the
    -- default and the only supported value at this time.
    DescribeEventDetails -> Maybe Text
locale :: Prelude.Maybe Prelude.Text,
    -- | A list of event ARNs (unique identifiers). For example:
    -- @\"arn:aws:health:us-east-1::event\/EC2\/EC2_INSTANCE_RETIREMENT_SCHEDULED\/EC2_INSTANCE_RETIREMENT_SCHEDULED_ABC123-CDE456\", \"arn:aws:health:us-west-1::event\/EBS\/AWS_EBS_LOST_VOLUME\/AWS_EBS_LOST_VOLUME_CHI789_JKL101\"@
    DescribeEventDetails -> NonEmpty Text
eventArns :: Prelude.NonEmpty Prelude.Text
  }
  deriving (DescribeEventDetails -> DescribeEventDetails -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DescribeEventDetails -> DescribeEventDetails -> Bool
$c/= :: DescribeEventDetails -> DescribeEventDetails -> Bool
== :: DescribeEventDetails -> DescribeEventDetails -> Bool
$c== :: DescribeEventDetails -> DescribeEventDetails -> Bool
Prelude.Eq, ReadPrec [DescribeEventDetails]
ReadPrec DescribeEventDetails
Int -> ReadS DescribeEventDetails
ReadS [DescribeEventDetails]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DescribeEventDetails]
$creadListPrec :: ReadPrec [DescribeEventDetails]
readPrec :: ReadPrec DescribeEventDetails
$creadPrec :: ReadPrec DescribeEventDetails
readList :: ReadS [DescribeEventDetails]
$creadList :: ReadS [DescribeEventDetails]
readsPrec :: Int -> ReadS DescribeEventDetails
$creadsPrec :: Int -> ReadS DescribeEventDetails
Prelude.Read, Int -> DescribeEventDetails -> ShowS
[DescribeEventDetails] -> ShowS
DescribeEventDetails -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DescribeEventDetails] -> ShowS
$cshowList :: [DescribeEventDetails] -> ShowS
show :: DescribeEventDetails -> String
$cshow :: DescribeEventDetails -> String
showsPrec :: Int -> DescribeEventDetails -> ShowS
$cshowsPrec :: Int -> DescribeEventDetails -> ShowS
Prelude.Show, forall x. Rep DescribeEventDetails x -> DescribeEventDetails
forall x. DescribeEventDetails -> Rep DescribeEventDetails x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep DescribeEventDetails x -> DescribeEventDetails
$cfrom :: forall x. DescribeEventDetails -> Rep DescribeEventDetails x
Prelude.Generic)

-- |
-- Create a value of 'DescribeEventDetails' 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:
--
-- 'locale', 'describeEventDetails_locale' - The locale (language) to return information in. English (en) is the
-- default and the only supported value at this time.
--
-- 'eventArns', 'describeEventDetails_eventArns' - A list of event ARNs (unique identifiers). For example:
-- @\"arn:aws:health:us-east-1::event\/EC2\/EC2_INSTANCE_RETIREMENT_SCHEDULED\/EC2_INSTANCE_RETIREMENT_SCHEDULED_ABC123-CDE456\", \"arn:aws:health:us-west-1::event\/EBS\/AWS_EBS_LOST_VOLUME\/AWS_EBS_LOST_VOLUME_CHI789_JKL101\"@
newDescribeEventDetails ::
  -- | 'eventArns'
  Prelude.NonEmpty Prelude.Text ->
  DescribeEventDetails
newDescribeEventDetails :: NonEmpty Text -> DescribeEventDetails
newDescribeEventDetails NonEmpty Text
pEventArns_ =
  DescribeEventDetails'
    { $sel:locale:DescribeEventDetails' :: Maybe Text
locale = forall a. Maybe a
Prelude.Nothing,
      $sel:eventArns:DescribeEventDetails' :: NonEmpty Text
eventArns = forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Lens.coerced forall t b. AReview t b -> b -> t
Lens.# NonEmpty Text
pEventArns_
    }

-- | The locale (language) to return information in. English (en) is the
-- default and the only supported value at this time.
describeEventDetails_locale :: Lens.Lens' DescribeEventDetails (Prelude.Maybe Prelude.Text)
describeEventDetails_locale :: Lens' DescribeEventDetails (Maybe Text)
describeEventDetails_locale = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeEventDetails' {Maybe Text
locale :: Maybe Text
$sel:locale:DescribeEventDetails' :: DescribeEventDetails -> Maybe Text
locale} -> Maybe Text
locale) (\s :: DescribeEventDetails
s@DescribeEventDetails' {} Maybe Text
a -> DescribeEventDetails
s {$sel:locale:DescribeEventDetails' :: Maybe Text
locale = Maybe Text
a} :: DescribeEventDetails)

-- | A list of event ARNs (unique identifiers). For example:
-- @\"arn:aws:health:us-east-1::event\/EC2\/EC2_INSTANCE_RETIREMENT_SCHEDULED\/EC2_INSTANCE_RETIREMENT_SCHEDULED_ABC123-CDE456\", \"arn:aws:health:us-west-1::event\/EBS\/AWS_EBS_LOST_VOLUME\/AWS_EBS_LOST_VOLUME_CHI789_JKL101\"@
describeEventDetails_eventArns :: Lens.Lens' DescribeEventDetails (Prelude.NonEmpty Prelude.Text)
describeEventDetails_eventArns :: Lens' DescribeEventDetails (NonEmpty Text)
describeEventDetails_eventArns = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeEventDetails' {NonEmpty Text
eventArns :: NonEmpty Text
$sel:eventArns:DescribeEventDetails' :: DescribeEventDetails -> NonEmpty Text
eventArns} -> NonEmpty Text
eventArns) (\s :: DescribeEventDetails
s@DescribeEventDetails' {} NonEmpty Text
a -> DescribeEventDetails
s {$sel:eventArns:DescribeEventDetails' :: NonEmpty Text
eventArns = NonEmpty Text
a} :: DescribeEventDetails) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Lens.coerced

instance Core.AWSRequest DescribeEventDetails where
  type
    AWSResponse DescribeEventDetails =
      DescribeEventDetailsResponse
  request :: (Service -> Service)
-> DescribeEventDetails -> Request DescribeEventDetails
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 DescribeEventDetails
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse DescribeEventDetails)))
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 [EventDetailsErrorItem]
-> Maybe [EventDetails] -> Int -> DescribeEventDetailsResponse
DescribeEventDetailsResponse'
            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
"failedSet" 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
"successfulSet" 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.<*> (forall (f :: * -> *) a. Applicative f => a -> f a
Prelude.pure (forall a. Enum a => a -> Int
Prelude.fromEnum Int
s))
      )

instance Prelude.Hashable DescribeEventDetails where
  hashWithSalt :: Int -> DescribeEventDetails -> Int
hashWithSalt Int
_salt DescribeEventDetails' {Maybe Text
NonEmpty Text
eventArns :: NonEmpty Text
locale :: Maybe Text
$sel:eventArns:DescribeEventDetails' :: DescribeEventDetails -> NonEmpty Text
$sel:locale:DescribeEventDetails' :: DescribeEventDetails -> Maybe Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
locale
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` NonEmpty Text
eventArns

instance Prelude.NFData DescribeEventDetails where
  rnf :: DescribeEventDetails -> ()
rnf DescribeEventDetails' {Maybe Text
NonEmpty Text
eventArns :: NonEmpty Text
locale :: Maybe Text
$sel:eventArns:DescribeEventDetails' :: DescribeEventDetails -> NonEmpty Text
$sel:locale:DescribeEventDetails' :: DescribeEventDetails -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
locale
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf NonEmpty Text
eventArns

instance Data.ToHeaders DescribeEventDetails where
  toHeaders :: DescribeEventDetails -> 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.DescribeEventDetails" ::
                          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 DescribeEventDetails where
  toJSON :: DescribeEventDetails -> Value
toJSON DescribeEventDetails' {Maybe Text
NonEmpty Text
eventArns :: NonEmpty Text
locale :: Maybe Text
$sel:eventArns:DescribeEventDetails' :: DescribeEventDetails -> NonEmpty Text
$sel:locale:DescribeEventDetails' :: DescribeEventDetails -> Maybe Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"locale" 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
locale,
            forall a. a -> Maybe a
Prelude.Just (Key
"eventArns" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= NonEmpty Text
eventArns)
          ]
      )

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

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

-- | /See:/ 'newDescribeEventDetailsResponse' smart constructor.
data DescribeEventDetailsResponse = DescribeEventDetailsResponse'
  { -- | Error messages for any events that could not be retrieved.
    DescribeEventDetailsResponse -> Maybe [EventDetailsErrorItem]
failedSet :: Prelude.Maybe [EventDetailsErrorItem],
    -- | Information about the events that could be retrieved.
    DescribeEventDetailsResponse -> Maybe [EventDetails]
successfulSet :: Prelude.Maybe [EventDetails],
    -- | The response's http status code.
    DescribeEventDetailsResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (DescribeEventDetailsResponse
-> DescribeEventDetailsResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DescribeEventDetailsResponse
-> DescribeEventDetailsResponse -> Bool
$c/= :: DescribeEventDetailsResponse
-> DescribeEventDetailsResponse -> Bool
== :: DescribeEventDetailsResponse
-> DescribeEventDetailsResponse -> Bool
$c== :: DescribeEventDetailsResponse
-> DescribeEventDetailsResponse -> Bool
Prelude.Eq, ReadPrec [DescribeEventDetailsResponse]
ReadPrec DescribeEventDetailsResponse
Int -> ReadS DescribeEventDetailsResponse
ReadS [DescribeEventDetailsResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DescribeEventDetailsResponse]
$creadListPrec :: ReadPrec [DescribeEventDetailsResponse]
readPrec :: ReadPrec DescribeEventDetailsResponse
$creadPrec :: ReadPrec DescribeEventDetailsResponse
readList :: ReadS [DescribeEventDetailsResponse]
$creadList :: ReadS [DescribeEventDetailsResponse]
readsPrec :: Int -> ReadS DescribeEventDetailsResponse
$creadsPrec :: Int -> ReadS DescribeEventDetailsResponse
Prelude.Read, Int -> DescribeEventDetailsResponse -> ShowS
[DescribeEventDetailsResponse] -> ShowS
DescribeEventDetailsResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DescribeEventDetailsResponse] -> ShowS
$cshowList :: [DescribeEventDetailsResponse] -> ShowS
show :: DescribeEventDetailsResponse -> String
$cshow :: DescribeEventDetailsResponse -> String
showsPrec :: Int -> DescribeEventDetailsResponse -> ShowS
$cshowsPrec :: Int -> DescribeEventDetailsResponse -> ShowS
Prelude.Show, forall x.
Rep DescribeEventDetailsResponse x -> DescribeEventDetailsResponse
forall x.
DescribeEventDetailsResponse -> Rep DescribeEventDetailsResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep DescribeEventDetailsResponse x -> DescribeEventDetailsResponse
$cfrom :: forall x.
DescribeEventDetailsResponse -> Rep DescribeEventDetailsResponse x
Prelude.Generic)

-- |
-- Create a value of 'DescribeEventDetailsResponse' 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:
--
-- 'failedSet', 'describeEventDetailsResponse_failedSet' - Error messages for any events that could not be retrieved.
--
-- 'successfulSet', 'describeEventDetailsResponse_successfulSet' - Information about the events that could be retrieved.
--
-- 'httpStatus', 'describeEventDetailsResponse_httpStatus' - The response's http status code.
newDescribeEventDetailsResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  DescribeEventDetailsResponse
newDescribeEventDetailsResponse :: Int -> DescribeEventDetailsResponse
newDescribeEventDetailsResponse Int
pHttpStatus_ =
  DescribeEventDetailsResponse'
    { $sel:failedSet:DescribeEventDetailsResponse' :: Maybe [EventDetailsErrorItem]
failedSet =
        forall a. Maybe a
Prelude.Nothing,
      $sel:successfulSet:DescribeEventDetailsResponse' :: Maybe [EventDetails]
successfulSet = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:DescribeEventDetailsResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | Error messages for any events that could not be retrieved.
describeEventDetailsResponse_failedSet :: Lens.Lens' DescribeEventDetailsResponse (Prelude.Maybe [EventDetailsErrorItem])
describeEventDetailsResponse_failedSet :: Lens' DescribeEventDetailsResponse (Maybe [EventDetailsErrorItem])
describeEventDetailsResponse_failedSet = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeEventDetailsResponse' {Maybe [EventDetailsErrorItem]
failedSet :: Maybe [EventDetailsErrorItem]
$sel:failedSet:DescribeEventDetailsResponse' :: DescribeEventDetailsResponse -> Maybe [EventDetailsErrorItem]
failedSet} -> Maybe [EventDetailsErrorItem]
failedSet) (\s :: DescribeEventDetailsResponse
s@DescribeEventDetailsResponse' {} Maybe [EventDetailsErrorItem]
a -> DescribeEventDetailsResponse
s {$sel:failedSet:DescribeEventDetailsResponse' :: Maybe [EventDetailsErrorItem]
failedSet = Maybe [EventDetailsErrorItem]
a} :: DescribeEventDetailsResponse) 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

-- | Information about the events that could be retrieved.
describeEventDetailsResponse_successfulSet :: Lens.Lens' DescribeEventDetailsResponse (Prelude.Maybe [EventDetails])
describeEventDetailsResponse_successfulSet :: Lens' DescribeEventDetailsResponse (Maybe [EventDetails])
describeEventDetailsResponse_successfulSet = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeEventDetailsResponse' {Maybe [EventDetails]
successfulSet :: Maybe [EventDetails]
$sel:successfulSet:DescribeEventDetailsResponse' :: DescribeEventDetailsResponse -> Maybe [EventDetails]
successfulSet} -> Maybe [EventDetails]
successfulSet) (\s :: DescribeEventDetailsResponse
s@DescribeEventDetailsResponse' {} Maybe [EventDetails]
a -> DescribeEventDetailsResponse
s {$sel:successfulSet:DescribeEventDetailsResponse' :: Maybe [EventDetails]
successfulSet = Maybe [EventDetails]
a} :: DescribeEventDetailsResponse) 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 response's http status code.
describeEventDetailsResponse_httpStatus :: Lens.Lens' DescribeEventDetailsResponse Prelude.Int
describeEventDetailsResponse_httpStatus :: Lens' DescribeEventDetailsResponse Int
describeEventDetailsResponse_httpStatus = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeEventDetailsResponse' {Int
httpStatus :: Int
$sel:httpStatus:DescribeEventDetailsResponse' :: DescribeEventDetailsResponse -> Int
httpStatus} -> Int
httpStatus) (\s :: DescribeEventDetailsResponse
s@DescribeEventDetailsResponse' {} Int
a -> DescribeEventDetailsResponse
s {$sel:httpStatus:DescribeEventDetailsResponse' :: Int
httpStatus = Int
a} :: DescribeEventDetailsResponse)

instance Prelude.NFData DescribeEventDetailsResponse where
  rnf :: DescribeEventDetailsResponse -> ()
rnf DescribeEventDetailsResponse' {Int
Maybe [EventDetailsErrorItem]
Maybe [EventDetails]
httpStatus :: Int
successfulSet :: Maybe [EventDetails]
failedSet :: Maybe [EventDetailsErrorItem]
$sel:httpStatus:DescribeEventDetailsResponse' :: DescribeEventDetailsResponse -> Int
$sel:successfulSet:DescribeEventDetailsResponse' :: DescribeEventDetailsResponse -> Maybe [EventDetails]
$sel:failedSet:DescribeEventDetailsResponse' :: DescribeEventDetailsResponse -> Maybe [EventDetailsErrorItem]
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe [EventDetailsErrorItem]
failedSet
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [EventDetails]
successfulSet
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus