{-# 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.PinpointSmsVoiceV2.CreateEventDestination
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Creates a new event destination in a configuration set.
--
-- An event destination is a location where you send message events. The
-- event options are Amazon CloudWatch, Amazon Kinesis Data Firehose, or
-- Amazon SNS. For example, when a message is delivered successfully, you
-- can send information about that event to an event destination, or send
-- notifications to endpoints that are subscribed to an Amazon SNS topic.
--
-- Each configuration set can contain between 0 and 5 event destinations.
-- Each event destination can contain a reference to a single destination,
-- such as a CloudWatch or Kinesis Data Firehose destination.
module Amazonka.PinpointSmsVoiceV2.CreateEventDestination
  ( -- * Creating a Request
    CreateEventDestination (..),
    newCreateEventDestination,

    -- * Request Lenses
    createEventDestination_clientToken,
    createEventDestination_cloudWatchLogsDestination,
    createEventDestination_kinesisFirehoseDestination,
    createEventDestination_snsDestination,
    createEventDestination_configurationSetName,
    createEventDestination_eventDestinationName,
    createEventDestination_matchingEventTypes,

    -- * Destructuring the Response
    CreateEventDestinationResponse (..),
    newCreateEventDestinationResponse,

    -- * Response Lenses
    createEventDestinationResponse_configurationSetArn,
    createEventDestinationResponse_configurationSetName,
    createEventDestinationResponse_eventDestination,
    createEventDestinationResponse_httpStatus,
  )
where

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

-- | /See:/ 'newCreateEventDestination' smart constructor.
data CreateEventDestination = CreateEventDestination'
  { -- | Unique, case-sensitive identifier that you provide to ensure the
    -- idempotency of the request. If you don\'t specify a client token, a
    -- randomly generated token is used for the request to ensure idempotency.
    CreateEventDestination -> Maybe Text
clientToken :: Prelude.Maybe Prelude.Text,
    -- | An object that contains information about an event destination for
    -- logging to Amazon CloudWatch logs.
    CreateEventDestination -> Maybe CloudWatchLogsDestination
cloudWatchLogsDestination :: Prelude.Maybe CloudWatchLogsDestination,
    -- | An object that contains information about an event destination for
    -- logging to Amazon Kinesis Data Firehose.
    CreateEventDestination -> Maybe KinesisFirehoseDestination
kinesisFirehoseDestination :: Prelude.Maybe KinesisFirehoseDestination,
    -- | An object that contains information about an event destination for
    -- logging to Amazon SNS.
    CreateEventDestination -> Maybe SnsDestination
snsDestination :: Prelude.Maybe SnsDestination,
    -- | Either the name of the configuration set or the configuration set ARN to
    -- apply event logging to. The ConfigurateSetName and ConfigurationSetArn
    -- can be found using the DescribeConfigurationSets action.
    CreateEventDestination -> Text
configurationSetName :: Prelude.Text,
    -- | The name that identifies the event destination.
    CreateEventDestination -> Text
eventDestinationName :: Prelude.Text,
    -- | An array of event types that determine which events to log. If \"ALL\"
    -- is used, then Amazon Pinpoint logs every event type.
    CreateEventDestination -> NonEmpty EventType
matchingEventTypes :: Prelude.NonEmpty EventType
  }
  deriving (CreateEventDestination -> CreateEventDestination -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateEventDestination -> CreateEventDestination -> Bool
$c/= :: CreateEventDestination -> CreateEventDestination -> Bool
== :: CreateEventDestination -> CreateEventDestination -> Bool
$c== :: CreateEventDestination -> CreateEventDestination -> Bool
Prelude.Eq, ReadPrec [CreateEventDestination]
ReadPrec CreateEventDestination
Int -> ReadS CreateEventDestination
ReadS [CreateEventDestination]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CreateEventDestination]
$creadListPrec :: ReadPrec [CreateEventDestination]
readPrec :: ReadPrec CreateEventDestination
$creadPrec :: ReadPrec CreateEventDestination
readList :: ReadS [CreateEventDestination]
$creadList :: ReadS [CreateEventDestination]
readsPrec :: Int -> ReadS CreateEventDestination
$creadsPrec :: Int -> ReadS CreateEventDestination
Prelude.Read, Int -> CreateEventDestination -> ShowS
[CreateEventDestination] -> ShowS
CreateEventDestination -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateEventDestination] -> ShowS
$cshowList :: [CreateEventDestination] -> ShowS
show :: CreateEventDestination -> String
$cshow :: CreateEventDestination -> String
showsPrec :: Int -> CreateEventDestination -> ShowS
$cshowsPrec :: Int -> CreateEventDestination -> ShowS
Prelude.Show, forall x. Rep CreateEventDestination x -> CreateEventDestination
forall x. CreateEventDestination -> Rep CreateEventDestination x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CreateEventDestination x -> CreateEventDestination
$cfrom :: forall x. CreateEventDestination -> Rep CreateEventDestination x
Prelude.Generic)

-- |
-- Create a value of 'CreateEventDestination' 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:
--
-- 'clientToken', 'createEventDestination_clientToken' - Unique, case-sensitive identifier that you provide to ensure the
-- idempotency of the request. If you don\'t specify a client token, a
-- randomly generated token is used for the request to ensure idempotency.
--
-- 'cloudWatchLogsDestination', 'createEventDestination_cloudWatchLogsDestination' - An object that contains information about an event destination for
-- logging to Amazon CloudWatch logs.
--
-- 'kinesisFirehoseDestination', 'createEventDestination_kinesisFirehoseDestination' - An object that contains information about an event destination for
-- logging to Amazon Kinesis Data Firehose.
--
-- 'snsDestination', 'createEventDestination_snsDestination' - An object that contains information about an event destination for
-- logging to Amazon SNS.
--
-- 'configurationSetName', 'createEventDestination_configurationSetName' - Either the name of the configuration set or the configuration set ARN to
-- apply event logging to. The ConfigurateSetName and ConfigurationSetArn
-- can be found using the DescribeConfigurationSets action.
--
-- 'eventDestinationName', 'createEventDestination_eventDestinationName' - The name that identifies the event destination.
--
-- 'matchingEventTypes', 'createEventDestination_matchingEventTypes' - An array of event types that determine which events to log. If \"ALL\"
-- is used, then Amazon Pinpoint logs every event type.
newCreateEventDestination ::
  -- | 'configurationSetName'
  Prelude.Text ->
  -- | 'eventDestinationName'
  Prelude.Text ->
  -- | 'matchingEventTypes'
  Prelude.NonEmpty EventType ->
  CreateEventDestination
newCreateEventDestination :: Text -> Text -> NonEmpty EventType -> CreateEventDestination
newCreateEventDestination
  Text
pConfigurationSetName_
  Text
pEventDestinationName_
  NonEmpty EventType
pMatchingEventTypes_ =
    CreateEventDestination'
      { $sel:clientToken:CreateEventDestination' :: Maybe Text
clientToken =
          forall a. Maybe a
Prelude.Nothing,
        $sel:cloudWatchLogsDestination:CreateEventDestination' :: Maybe CloudWatchLogsDestination
cloudWatchLogsDestination = forall a. Maybe a
Prelude.Nothing,
        $sel:kinesisFirehoseDestination:CreateEventDestination' :: Maybe KinesisFirehoseDestination
kinesisFirehoseDestination = forall a. Maybe a
Prelude.Nothing,
        $sel:snsDestination:CreateEventDestination' :: Maybe SnsDestination
snsDestination = forall a. Maybe a
Prelude.Nothing,
        $sel:configurationSetName:CreateEventDestination' :: Text
configurationSetName = Text
pConfigurationSetName_,
        $sel:eventDestinationName:CreateEventDestination' :: Text
eventDestinationName = Text
pEventDestinationName_,
        $sel:matchingEventTypes:CreateEventDestination' :: NonEmpty EventType
matchingEventTypes =
          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 EventType
pMatchingEventTypes_
      }

-- | Unique, case-sensitive identifier that you provide to ensure the
-- idempotency of the request. If you don\'t specify a client token, a
-- randomly generated token is used for the request to ensure idempotency.
createEventDestination_clientToken :: Lens.Lens' CreateEventDestination (Prelude.Maybe Prelude.Text)
createEventDestination_clientToken :: Lens' CreateEventDestination (Maybe Text)
createEventDestination_clientToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateEventDestination' {Maybe Text
clientToken :: Maybe Text
$sel:clientToken:CreateEventDestination' :: CreateEventDestination -> Maybe Text
clientToken} -> Maybe Text
clientToken) (\s :: CreateEventDestination
s@CreateEventDestination' {} Maybe Text
a -> CreateEventDestination
s {$sel:clientToken:CreateEventDestination' :: Maybe Text
clientToken = Maybe Text
a} :: CreateEventDestination)

-- | An object that contains information about an event destination for
-- logging to Amazon CloudWatch logs.
createEventDestination_cloudWatchLogsDestination :: Lens.Lens' CreateEventDestination (Prelude.Maybe CloudWatchLogsDestination)
createEventDestination_cloudWatchLogsDestination :: Lens' CreateEventDestination (Maybe CloudWatchLogsDestination)
createEventDestination_cloudWatchLogsDestination = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateEventDestination' {Maybe CloudWatchLogsDestination
cloudWatchLogsDestination :: Maybe CloudWatchLogsDestination
$sel:cloudWatchLogsDestination:CreateEventDestination' :: CreateEventDestination -> Maybe CloudWatchLogsDestination
cloudWatchLogsDestination} -> Maybe CloudWatchLogsDestination
cloudWatchLogsDestination) (\s :: CreateEventDestination
s@CreateEventDestination' {} Maybe CloudWatchLogsDestination
a -> CreateEventDestination
s {$sel:cloudWatchLogsDestination:CreateEventDestination' :: Maybe CloudWatchLogsDestination
cloudWatchLogsDestination = Maybe CloudWatchLogsDestination
a} :: CreateEventDestination)

-- | An object that contains information about an event destination for
-- logging to Amazon Kinesis Data Firehose.
createEventDestination_kinesisFirehoseDestination :: Lens.Lens' CreateEventDestination (Prelude.Maybe KinesisFirehoseDestination)
createEventDestination_kinesisFirehoseDestination :: Lens' CreateEventDestination (Maybe KinesisFirehoseDestination)
createEventDestination_kinesisFirehoseDestination = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateEventDestination' {Maybe KinesisFirehoseDestination
kinesisFirehoseDestination :: Maybe KinesisFirehoseDestination
$sel:kinesisFirehoseDestination:CreateEventDestination' :: CreateEventDestination -> Maybe KinesisFirehoseDestination
kinesisFirehoseDestination} -> Maybe KinesisFirehoseDestination
kinesisFirehoseDestination) (\s :: CreateEventDestination
s@CreateEventDestination' {} Maybe KinesisFirehoseDestination
a -> CreateEventDestination
s {$sel:kinesisFirehoseDestination:CreateEventDestination' :: Maybe KinesisFirehoseDestination
kinesisFirehoseDestination = Maybe KinesisFirehoseDestination
a} :: CreateEventDestination)

-- | An object that contains information about an event destination for
-- logging to Amazon SNS.
createEventDestination_snsDestination :: Lens.Lens' CreateEventDestination (Prelude.Maybe SnsDestination)
createEventDestination_snsDestination :: Lens' CreateEventDestination (Maybe SnsDestination)
createEventDestination_snsDestination = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateEventDestination' {Maybe SnsDestination
snsDestination :: Maybe SnsDestination
$sel:snsDestination:CreateEventDestination' :: CreateEventDestination -> Maybe SnsDestination
snsDestination} -> Maybe SnsDestination
snsDestination) (\s :: CreateEventDestination
s@CreateEventDestination' {} Maybe SnsDestination
a -> CreateEventDestination
s {$sel:snsDestination:CreateEventDestination' :: Maybe SnsDestination
snsDestination = Maybe SnsDestination
a} :: CreateEventDestination)

-- | Either the name of the configuration set or the configuration set ARN to
-- apply event logging to. The ConfigurateSetName and ConfigurationSetArn
-- can be found using the DescribeConfigurationSets action.
createEventDestination_configurationSetName :: Lens.Lens' CreateEventDestination Prelude.Text
createEventDestination_configurationSetName :: Lens' CreateEventDestination Text
createEventDestination_configurationSetName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateEventDestination' {Text
configurationSetName :: Text
$sel:configurationSetName:CreateEventDestination' :: CreateEventDestination -> Text
configurationSetName} -> Text
configurationSetName) (\s :: CreateEventDestination
s@CreateEventDestination' {} Text
a -> CreateEventDestination
s {$sel:configurationSetName:CreateEventDestination' :: Text
configurationSetName = Text
a} :: CreateEventDestination)

-- | The name that identifies the event destination.
createEventDestination_eventDestinationName :: Lens.Lens' CreateEventDestination Prelude.Text
createEventDestination_eventDestinationName :: Lens' CreateEventDestination Text
createEventDestination_eventDestinationName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateEventDestination' {Text
eventDestinationName :: Text
$sel:eventDestinationName:CreateEventDestination' :: CreateEventDestination -> Text
eventDestinationName} -> Text
eventDestinationName) (\s :: CreateEventDestination
s@CreateEventDestination' {} Text
a -> CreateEventDestination
s {$sel:eventDestinationName:CreateEventDestination' :: Text
eventDestinationName = Text
a} :: CreateEventDestination)

-- | An array of event types that determine which events to log. If \"ALL\"
-- is used, then Amazon Pinpoint logs every event type.
createEventDestination_matchingEventTypes :: Lens.Lens' CreateEventDestination (Prelude.NonEmpty EventType)
createEventDestination_matchingEventTypes :: Lens' CreateEventDestination (NonEmpty EventType)
createEventDestination_matchingEventTypes = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateEventDestination' {NonEmpty EventType
matchingEventTypes :: NonEmpty EventType
$sel:matchingEventTypes:CreateEventDestination' :: CreateEventDestination -> NonEmpty EventType
matchingEventTypes} -> NonEmpty EventType
matchingEventTypes) (\s :: CreateEventDestination
s@CreateEventDestination' {} NonEmpty EventType
a -> CreateEventDestination
s {$sel:matchingEventTypes:CreateEventDestination' :: NonEmpty EventType
matchingEventTypes = NonEmpty EventType
a} :: CreateEventDestination) 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 CreateEventDestination where
  type
    AWSResponse CreateEventDestination =
      CreateEventDestinationResponse
  request :: (Service -> Service)
-> CreateEventDestination -> Request CreateEventDestination
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 CreateEventDestination
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse CreateEventDestination)))
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 Text
-> Maybe Text
-> Maybe EventDestination
-> Int
-> CreateEventDestinationResponse
CreateEventDestinationResponse'
            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
"ConfigurationSetArn")
            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
"ConfigurationSetName")
            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
"EventDestination")
            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 CreateEventDestination where
  hashWithSalt :: Int -> CreateEventDestination -> Int
hashWithSalt Int
_salt CreateEventDestination' {Maybe Text
Maybe CloudWatchLogsDestination
Maybe KinesisFirehoseDestination
Maybe SnsDestination
NonEmpty EventType
Text
matchingEventTypes :: NonEmpty EventType
eventDestinationName :: Text
configurationSetName :: Text
snsDestination :: Maybe SnsDestination
kinesisFirehoseDestination :: Maybe KinesisFirehoseDestination
cloudWatchLogsDestination :: Maybe CloudWatchLogsDestination
clientToken :: Maybe Text
$sel:matchingEventTypes:CreateEventDestination' :: CreateEventDestination -> NonEmpty EventType
$sel:eventDestinationName:CreateEventDestination' :: CreateEventDestination -> Text
$sel:configurationSetName:CreateEventDestination' :: CreateEventDestination -> Text
$sel:snsDestination:CreateEventDestination' :: CreateEventDestination -> Maybe SnsDestination
$sel:kinesisFirehoseDestination:CreateEventDestination' :: CreateEventDestination -> Maybe KinesisFirehoseDestination
$sel:cloudWatchLogsDestination:CreateEventDestination' :: CreateEventDestination -> Maybe CloudWatchLogsDestination
$sel:clientToken:CreateEventDestination' :: CreateEventDestination -> Maybe Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
clientToken
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe CloudWatchLogsDestination
cloudWatchLogsDestination
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe KinesisFirehoseDestination
kinesisFirehoseDestination
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe SnsDestination
snsDestination
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
configurationSetName
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
eventDestinationName
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` NonEmpty EventType
matchingEventTypes

instance Prelude.NFData CreateEventDestination where
  rnf :: CreateEventDestination -> ()
rnf CreateEventDestination' {Maybe Text
Maybe CloudWatchLogsDestination
Maybe KinesisFirehoseDestination
Maybe SnsDestination
NonEmpty EventType
Text
matchingEventTypes :: NonEmpty EventType
eventDestinationName :: Text
configurationSetName :: Text
snsDestination :: Maybe SnsDestination
kinesisFirehoseDestination :: Maybe KinesisFirehoseDestination
cloudWatchLogsDestination :: Maybe CloudWatchLogsDestination
clientToken :: Maybe Text
$sel:matchingEventTypes:CreateEventDestination' :: CreateEventDestination -> NonEmpty EventType
$sel:eventDestinationName:CreateEventDestination' :: CreateEventDestination -> Text
$sel:configurationSetName:CreateEventDestination' :: CreateEventDestination -> Text
$sel:snsDestination:CreateEventDestination' :: CreateEventDestination -> Maybe SnsDestination
$sel:kinesisFirehoseDestination:CreateEventDestination' :: CreateEventDestination -> Maybe KinesisFirehoseDestination
$sel:cloudWatchLogsDestination:CreateEventDestination' :: CreateEventDestination -> Maybe CloudWatchLogsDestination
$sel:clientToken:CreateEventDestination' :: CreateEventDestination -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
clientToken
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe CloudWatchLogsDestination
cloudWatchLogsDestination
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe KinesisFirehoseDestination
kinesisFirehoseDestination
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe SnsDestination
snsDestination
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
configurationSetName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
eventDestinationName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf NonEmpty EventType
matchingEventTypes

instance Data.ToHeaders CreateEventDestination where
  toHeaders :: CreateEventDestination -> 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
"PinpointSMSVoiceV2.CreateEventDestination" ::
                          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 CreateEventDestination where
  toJSON :: CreateEventDestination -> Value
toJSON CreateEventDestination' {Maybe Text
Maybe CloudWatchLogsDestination
Maybe KinesisFirehoseDestination
Maybe SnsDestination
NonEmpty EventType
Text
matchingEventTypes :: NonEmpty EventType
eventDestinationName :: Text
configurationSetName :: Text
snsDestination :: Maybe SnsDestination
kinesisFirehoseDestination :: Maybe KinesisFirehoseDestination
cloudWatchLogsDestination :: Maybe CloudWatchLogsDestination
clientToken :: Maybe Text
$sel:matchingEventTypes:CreateEventDestination' :: CreateEventDestination -> NonEmpty EventType
$sel:eventDestinationName:CreateEventDestination' :: CreateEventDestination -> Text
$sel:configurationSetName:CreateEventDestination' :: CreateEventDestination -> Text
$sel:snsDestination:CreateEventDestination' :: CreateEventDestination -> Maybe SnsDestination
$sel:kinesisFirehoseDestination:CreateEventDestination' :: CreateEventDestination -> Maybe KinesisFirehoseDestination
$sel:cloudWatchLogsDestination:CreateEventDestination' :: CreateEventDestination -> Maybe CloudWatchLogsDestination
$sel:clientToken:CreateEventDestination' :: CreateEventDestination -> Maybe Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"ClientToken" 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
clientToken,
            (Key
"CloudWatchLogsDestination" 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 CloudWatchLogsDestination
cloudWatchLogsDestination,
            (Key
"KinesisFirehoseDestination" 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 KinesisFirehoseDestination
kinesisFirehoseDestination,
            (Key
"SnsDestination" 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 SnsDestination
snsDestination,
            forall a. a -> Maybe a
Prelude.Just
              ( Key
"ConfigurationSetName"
                  forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
configurationSetName
              ),
            forall a. a -> Maybe a
Prelude.Just
              ( Key
"EventDestinationName"
                  forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
eventDestinationName
              ),
            forall a. a -> Maybe a
Prelude.Just
              (Key
"MatchingEventTypes" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= NonEmpty EventType
matchingEventTypes)
          ]
      )

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

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

-- | /See:/ 'newCreateEventDestinationResponse' smart constructor.
data CreateEventDestinationResponse = CreateEventDestinationResponse'
  { -- | The ARN of the configuration set.
    CreateEventDestinationResponse -> Maybe Text
configurationSetArn :: Prelude.Maybe Prelude.Text,
    -- | The name of the configuration set.
    CreateEventDestinationResponse -> Maybe Text
configurationSetName :: Prelude.Maybe Prelude.Text,
    -- | The details of the destination where events are logged.
    CreateEventDestinationResponse -> Maybe EventDestination
eventDestination :: Prelude.Maybe EventDestination,
    -- | The response's http status code.
    CreateEventDestinationResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (CreateEventDestinationResponse
-> CreateEventDestinationResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateEventDestinationResponse
-> CreateEventDestinationResponse -> Bool
$c/= :: CreateEventDestinationResponse
-> CreateEventDestinationResponse -> Bool
== :: CreateEventDestinationResponse
-> CreateEventDestinationResponse -> Bool
$c== :: CreateEventDestinationResponse
-> CreateEventDestinationResponse -> Bool
Prelude.Eq, ReadPrec [CreateEventDestinationResponse]
ReadPrec CreateEventDestinationResponse
Int -> ReadS CreateEventDestinationResponse
ReadS [CreateEventDestinationResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CreateEventDestinationResponse]
$creadListPrec :: ReadPrec [CreateEventDestinationResponse]
readPrec :: ReadPrec CreateEventDestinationResponse
$creadPrec :: ReadPrec CreateEventDestinationResponse
readList :: ReadS [CreateEventDestinationResponse]
$creadList :: ReadS [CreateEventDestinationResponse]
readsPrec :: Int -> ReadS CreateEventDestinationResponse
$creadsPrec :: Int -> ReadS CreateEventDestinationResponse
Prelude.Read, Int -> CreateEventDestinationResponse -> ShowS
[CreateEventDestinationResponse] -> ShowS
CreateEventDestinationResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateEventDestinationResponse] -> ShowS
$cshowList :: [CreateEventDestinationResponse] -> ShowS
show :: CreateEventDestinationResponse -> String
$cshow :: CreateEventDestinationResponse -> String
showsPrec :: Int -> CreateEventDestinationResponse -> ShowS
$cshowsPrec :: Int -> CreateEventDestinationResponse -> ShowS
Prelude.Show, forall x.
Rep CreateEventDestinationResponse x
-> CreateEventDestinationResponse
forall x.
CreateEventDestinationResponse
-> Rep CreateEventDestinationResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep CreateEventDestinationResponse x
-> CreateEventDestinationResponse
$cfrom :: forall x.
CreateEventDestinationResponse
-> Rep CreateEventDestinationResponse x
Prelude.Generic)

-- |
-- Create a value of 'CreateEventDestinationResponse' 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:
--
-- 'configurationSetArn', 'createEventDestinationResponse_configurationSetArn' - The ARN of the configuration set.
--
-- 'configurationSetName', 'createEventDestinationResponse_configurationSetName' - The name of the configuration set.
--
-- 'eventDestination', 'createEventDestinationResponse_eventDestination' - The details of the destination where events are logged.
--
-- 'httpStatus', 'createEventDestinationResponse_httpStatus' - The response's http status code.
newCreateEventDestinationResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  CreateEventDestinationResponse
newCreateEventDestinationResponse :: Int -> CreateEventDestinationResponse
newCreateEventDestinationResponse Int
pHttpStatus_ =
  CreateEventDestinationResponse'
    { $sel:configurationSetArn:CreateEventDestinationResponse' :: Maybe Text
configurationSetArn =
        forall a. Maybe a
Prelude.Nothing,
      $sel:configurationSetName:CreateEventDestinationResponse' :: Maybe Text
configurationSetName = forall a. Maybe a
Prelude.Nothing,
      $sel:eventDestination:CreateEventDestinationResponse' :: Maybe EventDestination
eventDestination = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:CreateEventDestinationResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | The ARN of the configuration set.
createEventDestinationResponse_configurationSetArn :: Lens.Lens' CreateEventDestinationResponse (Prelude.Maybe Prelude.Text)
createEventDestinationResponse_configurationSetArn :: Lens' CreateEventDestinationResponse (Maybe Text)
createEventDestinationResponse_configurationSetArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateEventDestinationResponse' {Maybe Text
configurationSetArn :: Maybe Text
$sel:configurationSetArn:CreateEventDestinationResponse' :: CreateEventDestinationResponse -> Maybe Text
configurationSetArn} -> Maybe Text
configurationSetArn) (\s :: CreateEventDestinationResponse
s@CreateEventDestinationResponse' {} Maybe Text
a -> CreateEventDestinationResponse
s {$sel:configurationSetArn:CreateEventDestinationResponse' :: Maybe Text
configurationSetArn = Maybe Text
a} :: CreateEventDestinationResponse)

-- | The name of the configuration set.
createEventDestinationResponse_configurationSetName :: Lens.Lens' CreateEventDestinationResponse (Prelude.Maybe Prelude.Text)
createEventDestinationResponse_configurationSetName :: Lens' CreateEventDestinationResponse (Maybe Text)
createEventDestinationResponse_configurationSetName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateEventDestinationResponse' {Maybe Text
configurationSetName :: Maybe Text
$sel:configurationSetName:CreateEventDestinationResponse' :: CreateEventDestinationResponse -> Maybe Text
configurationSetName} -> Maybe Text
configurationSetName) (\s :: CreateEventDestinationResponse
s@CreateEventDestinationResponse' {} Maybe Text
a -> CreateEventDestinationResponse
s {$sel:configurationSetName:CreateEventDestinationResponse' :: Maybe Text
configurationSetName = Maybe Text
a} :: CreateEventDestinationResponse)

-- | The details of the destination where events are logged.
createEventDestinationResponse_eventDestination :: Lens.Lens' CreateEventDestinationResponse (Prelude.Maybe EventDestination)
createEventDestinationResponse_eventDestination :: Lens' CreateEventDestinationResponse (Maybe EventDestination)
createEventDestinationResponse_eventDestination = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateEventDestinationResponse' {Maybe EventDestination
eventDestination :: Maybe EventDestination
$sel:eventDestination:CreateEventDestinationResponse' :: CreateEventDestinationResponse -> Maybe EventDestination
eventDestination} -> Maybe EventDestination
eventDestination) (\s :: CreateEventDestinationResponse
s@CreateEventDestinationResponse' {} Maybe EventDestination
a -> CreateEventDestinationResponse
s {$sel:eventDestination:CreateEventDestinationResponse' :: Maybe EventDestination
eventDestination = Maybe EventDestination
a} :: CreateEventDestinationResponse)

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

instance
  Prelude.NFData
    CreateEventDestinationResponse
  where
  rnf :: CreateEventDestinationResponse -> ()
rnf CreateEventDestinationResponse' {Int
Maybe Text
Maybe EventDestination
httpStatus :: Int
eventDestination :: Maybe EventDestination
configurationSetName :: Maybe Text
configurationSetArn :: Maybe Text
$sel:httpStatus:CreateEventDestinationResponse' :: CreateEventDestinationResponse -> Int
$sel:eventDestination:CreateEventDestinationResponse' :: CreateEventDestinationResponse -> Maybe EventDestination
$sel:configurationSetName:CreateEventDestinationResponse' :: CreateEventDestinationResponse -> Maybe Text
$sel:configurationSetArn:CreateEventDestinationResponse' :: CreateEventDestinationResponse -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
configurationSetArn
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
configurationSetName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe EventDestination
eventDestination
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus