{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE StrictData #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# OPTIONS_GHC -fno-warn-unused-imports #-}
{-# OPTIONS_GHC -fno-warn-unused-matches #-}

-- Derived from AWS service descriptions, licensed under Apache 2.0.

-- |
-- Module      : Amazonka.SES.Types.EventDestination
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
module Amazonka.SES.Types.EventDestination where

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 Amazonka.SES.Types.CloudWatchDestination
import Amazonka.SES.Types.EventType
import Amazonka.SES.Types.KinesisFirehoseDestination
import Amazonka.SES.Types.SNSDestination

-- | Contains information about the event destination that the specified
-- email sending events will be published to.
--
-- When you create or update an event destination, you must provide one,
-- and only one, destination. The destination can be Amazon CloudWatch,
-- Amazon Kinesis Firehose or Amazon Simple Notification Service (Amazon
-- SNS).
--
-- Event destinations are associated with configuration sets, which enable
-- you to publish email sending events to Amazon CloudWatch, Amazon Kinesis
-- Firehose, or Amazon Simple Notification Service (Amazon SNS). For
-- information about using configuration sets, see the
-- <https://docs.aws.amazon.com/ses/latest/DeveloperGuide/monitor-sending-activity.html Amazon SES Developer Guide>.
--
-- /See:/ 'newEventDestination' smart constructor.
data EventDestination = EventDestination'
  { -- | An object that contains the names, default values, and sources of the
    -- dimensions associated with an Amazon CloudWatch event destination.
    EventDestination -> Maybe CloudWatchDestination
cloudWatchDestination :: Prelude.Maybe CloudWatchDestination,
    -- | Sets whether Amazon SES publishes events to this destination when you
    -- send an email with the associated configuration set. Set to @true@ to
    -- enable publishing to this destination; set to @false@ to prevent
    -- publishing to this destination. The default value is @false@.
    EventDestination -> Maybe Bool
enabled :: Prelude.Maybe Prelude.Bool,
    -- | An object that contains the delivery stream ARN and the IAM role ARN
    -- associated with an Amazon Kinesis Firehose event destination.
    EventDestination -> Maybe KinesisFirehoseDestination
kinesisFirehoseDestination :: Prelude.Maybe KinesisFirehoseDestination,
    -- | An object that contains the topic ARN associated with an Amazon Simple
    -- Notification Service (Amazon SNS) event destination.
    EventDestination -> Maybe SNSDestination
sNSDestination :: Prelude.Maybe SNSDestination,
    -- | The name of the event destination. The name must:
    --
    -- -   This value can only contain ASCII letters (a-z, A-Z), numbers (0-9),
    --     underscores (_), or dashes (-).
    --
    -- -   Contain less than 64 characters.
    EventDestination -> Text
name :: Prelude.Text,
    -- | The type of email sending events to publish to the event destination.
    EventDestination -> [EventType]
matchingEventTypes :: [EventType]
  }
  deriving (EventDestination -> EventDestination -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: EventDestination -> EventDestination -> Bool
$c/= :: EventDestination -> EventDestination -> Bool
== :: EventDestination -> EventDestination -> Bool
$c== :: EventDestination -> EventDestination -> Bool
Prelude.Eq, ReadPrec [EventDestination]
ReadPrec EventDestination
Int -> ReadS EventDestination
ReadS [EventDestination]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [EventDestination]
$creadListPrec :: ReadPrec [EventDestination]
readPrec :: ReadPrec EventDestination
$creadPrec :: ReadPrec EventDestination
readList :: ReadS [EventDestination]
$creadList :: ReadS [EventDestination]
readsPrec :: Int -> ReadS EventDestination
$creadsPrec :: Int -> ReadS EventDestination
Prelude.Read, Int -> EventDestination -> ShowS
[EventDestination] -> ShowS
EventDestination -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [EventDestination] -> ShowS
$cshowList :: [EventDestination] -> ShowS
show :: EventDestination -> String
$cshow :: EventDestination -> String
showsPrec :: Int -> EventDestination -> ShowS
$cshowsPrec :: Int -> EventDestination -> ShowS
Prelude.Show, forall x. Rep EventDestination x -> EventDestination
forall x. EventDestination -> Rep EventDestination x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep EventDestination x -> EventDestination
$cfrom :: forall x. EventDestination -> Rep EventDestination x
Prelude.Generic)

-- |
-- Create a value of 'EventDestination' 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:
--
-- 'cloudWatchDestination', 'eventDestination_cloudWatchDestination' - An object that contains the names, default values, and sources of the
-- dimensions associated with an Amazon CloudWatch event destination.
--
-- 'enabled', 'eventDestination_enabled' - Sets whether Amazon SES publishes events to this destination when you
-- send an email with the associated configuration set. Set to @true@ to
-- enable publishing to this destination; set to @false@ to prevent
-- publishing to this destination. The default value is @false@.
--
-- 'kinesisFirehoseDestination', 'eventDestination_kinesisFirehoseDestination' - An object that contains the delivery stream ARN and the IAM role ARN
-- associated with an Amazon Kinesis Firehose event destination.
--
-- 'sNSDestination', 'eventDestination_sNSDestination' - An object that contains the topic ARN associated with an Amazon Simple
-- Notification Service (Amazon SNS) event destination.
--
-- 'name', 'eventDestination_name' - The name of the event destination. The name must:
--
-- -   This value can only contain ASCII letters (a-z, A-Z), numbers (0-9),
--     underscores (_), or dashes (-).
--
-- -   Contain less than 64 characters.
--
-- 'matchingEventTypes', 'eventDestination_matchingEventTypes' - The type of email sending events to publish to the event destination.
newEventDestination ::
  -- | 'name'
  Prelude.Text ->
  EventDestination
newEventDestination :: Text -> EventDestination
newEventDestination Text
pName_ =
  EventDestination'
    { $sel:cloudWatchDestination:EventDestination' :: Maybe CloudWatchDestination
cloudWatchDestination =
        forall a. Maybe a
Prelude.Nothing,
      $sel:enabled:EventDestination' :: Maybe Bool
enabled = forall a. Maybe a
Prelude.Nothing,
      $sel:kinesisFirehoseDestination:EventDestination' :: Maybe KinesisFirehoseDestination
kinesisFirehoseDestination = forall a. Maybe a
Prelude.Nothing,
      $sel:sNSDestination:EventDestination' :: Maybe SNSDestination
sNSDestination = forall a. Maybe a
Prelude.Nothing,
      $sel:name:EventDestination' :: Text
name = Text
pName_,
      $sel:matchingEventTypes:EventDestination' :: [EventType]
matchingEventTypes = forall a. Monoid a => a
Prelude.mempty
    }

-- | An object that contains the names, default values, and sources of the
-- dimensions associated with an Amazon CloudWatch event destination.
eventDestination_cloudWatchDestination :: Lens.Lens' EventDestination (Prelude.Maybe CloudWatchDestination)
eventDestination_cloudWatchDestination :: Lens' EventDestination (Maybe CloudWatchDestination)
eventDestination_cloudWatchDestination = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\EventDestination' {Maybe CloudWatchDestination
cloudWatchDestination :: Maybe CloudWatchDestination
$sel:cloudWatchDestination:EventDestination' :: EventDestination -> Maybe CloudWatchDestination
cloudWatchDestination} -> Maybe CloudWatchDestination
cloudWatchDestination) (\s :: EventDestination
s@EventDestination' {} Maybe CloudWatchDestination
a -> EventDestination
s {$sel:cloudWatchDestination:EventDestination' :: Maybe CloudWatchDestination
cloudWatchDestination = Maybe CloudWatchDestination
a} :: EventDestination)

-- | Sets whether Amazon SES publishes events to this destination when you
-- send an email with the associated configuration set. Set to @true@ to
-- enable publishing to this destination; set to @false@ to prevent
-- publishing to this destination. The default value is @false@.
eventDestination_enabled :: Lens.Lens' EventDestination (Prelude.Maybe Prelude.Bool)
eventDestination_enabled :: Lens' EventDestination (Maybe Bool)
eventDestination_enabled = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\EventDestination' {Maybe Bool
enabled :: Maybe Bool
$sel:enabled:EventDestination' :: EventDestination -> Maybe Bool
enabled} -> Maybe Bool
enabled) (\s :: EventDestination
s@EventDestination' {} Maybe Bool
a -> EventDestination
s {$sel:enabled:EventDestination' :: Maybe Bool
enabled = Maybe Bool
a} :: EventDestination)

-- | An object that contains the delivery stream ARN and the IAM role ARN
-- associated with an Amazon Kinesis Firehose event destination.
eventDestination_kinesisFirehoseDestination :: Lens.Lens' EventDestination (Prelude.Maybe KinesisFirehoseDestination)
eventDestination_kinesisFirehoseDestination :: Lens' EventDestination (Maybe KinesisFirehoseDestination)
eventDestination_kinesisFirehoseDestination = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\EventDestination' {Maybe KinesisFirehoseDestination
kinesisFirehoseDestination :: Maybe KinesisFirehoseDestination
$sel:kinesisFirehoseDestination:EventDestination' :: EventDestination -> Maybe KinesisFirehoseDestination
kinesisFirehoseDestination} -> Maybe KinesisFirehoseDestination
kinesisFirehoseDestination) (\s :: EventDestination
s@EventDestination' {} Maybe KinesisFirehoseDestination
a -> EventDestination
s {$sel:kinesisFirehoseDestination:EventDestination' :: Maybe KinesisFirehoseDestination
kinesisFirehoseDestination = Maybe KinesisFirehoseDestination
a} :: EventDestination)

-- | An object that contains the topic ARN associated with an Amazon Simple
-- Notification Service (Amazon SNS) event destination.
eventDestination_sNSDestination :: Lens.Lens' EventDestination (Prelude.Maybe SNSDestination)
eventDestination_sNSDestination :: Lens' EventDestination (Maybe SNSDestination)
eventDestination_sNSDestination = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\EventDestination' {Maybe SNSDestination
sNSDestination :: Maybe SNSDestination
$sel:sNSDestination:EventDestination' :: EventDestination -> Maybe SNSDestination
sNSDestination} -> Maybe SNSDestination
sNSDestination) (\s :: EventDestination
s@EventDestination' {} Maybe SNSDestination
a -> EventDestination
s {$sel:sNSDestination:EventDestination' :: Maybe SNSDestination
sNSDestination = Maybe SNSDestination
a} :: EventDestination)

-- | The name of the event destination. The name must:
--
-- -   This value can only contain ASCII letters (a-z, A-Z), numbers (0-9),
--     underscores (_), or dashes (-).
--
-- -   Contain less than 64 characters.
eventDestination_name :: Lens.Lens' EventDestination Prelude.Text
eventDestination_name :: Lens' EventDestination Text
eventDestination_name = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\EventDestination' {Text
name :: Text
$sel:name:EventDestination' :: EventDestination -> Text
name} -> Text
name) (\s :: EventDestination
s@EventDestination' {} Text
a -> EventDestination
s {$sel:name:EventDestination' :: Text
name = Text
a} :: EventDestination)

-- | The type of email sending events to publish to the event destination.
eventDestination_matchingEventTypes :: Lens.Lens' EventDestination [EventType]
eventDestination_matchingEventTypes :: Lens' EventDestination [EventType]
eventDestination_matchingEventTypes = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\EventDestination' {[EventType]
matchingEventTypes :: [EventType]
$sel:matchingEventTypes:EventDestination' :: EventDestination -> [EventType]
matchingEventTypes} -> [EventType]
matchingEventTypes) (\s :: EventDestination
s@EventDestination' {} [EventType]
a -> EventDestination
s {$sel:matchingEventTypes:EventDestination' :: [EventType]
matchingEventTypes = [EventType]
a} :: EventDestination) 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 Data.FromXML EventDestination where
  parseXML :: [Node] -> Either String EventDestination
parseXML [Node]
x =
    Maybe CloudWatchDestination
-> Maybe Bool
-> Maybe KinesisFirehoseDestination
-> Maybe SNSDestination
-> Text
-> [EventType]
-> EventDestination
EventDestination'
      forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> ([Node]
x forall a. FromXML a => [Node] -> Text -> Either String (Maybe a)
Data..@? Text
"CloudWatchDestination")
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> ([Node]
x forall a. FromXML a => [Node] -> Text -> Either String (Maybe a)
Data..@? Text
"Enabled")
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> ([Node]
x forall a. FromXML a => [Node] -> Text -> Either String (Maybe a)
Data..@? Text
"KinesisFirehoseDestination")
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> ([Node]
x forall a. FromXML a => [Node] -> Text -> Either String (Maybe a)
Data..@? Text
"SNSDestination")
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> ([Node]
x forall a. FromXML a => [Node] -> Text -> Either String a
Data..@ Text
"Name")
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> ( [Node]
x
                      forall a. FromXML a => [Node] -> Text -> Either String (Maybe a)
Data..@? Text
"MatchingEventTypes"
                      forall (f :: * -> *) a. Functor f => f (Maybe a) -> a -> f a
Core..!@ forall a. Monoid a => a
Prelude.mempty
                      forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
Prelude.>>= forall a. FromXML a => Text -> [Node] -> Either String [a]
Data.parseXMLList Text
"member"
                  )

instance Prelude.Hashable EventDestination where
  hashWithSalt :: Int -> EventDestination -> Int
hashWithSalt Int
_salt EventDestination' {[EventType]
Maybe Bool
Maybe CloudWatchDestination
Maybe KinesisFirehoseDestination
Maybe SNSDestination
Text
matchingEventTypes :: [EventType]
name :: Text
sNSDestination :: Maybe SNSDestination
kinesisFirehoseDestination :: Maybe KinesisFirehoseDestination
enabled :: Maybe Bool
cloudWatchDestination :: Maybe CloudWatchDestination
$sel:matchingEventTypes:EventDestination' :: EventDestination -> [EventType]
$sel:name:EventDestination' :: EventDestination -> Text
$sel:sNSDestination:EventDestination' :: EventDestination -> Maybe SNSDestination
$sel:kinesisFirehoseDestination:EventDestination' :: EventDestination -> Maybe KinesisFirehoseDestination
$sel:enabled:EventDestination' :: EventDestination -> Maybe Bool
$sel:cloudWatchDestination:EventDestination' :: EventDestination -> Maybe CloudWatchDestination
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe CloudWatchDestination
cloudWatchDestination
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Bool
enabled
      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
name
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` [EventType]
matchingEventTypes

instance Prelude.NFData EventDestination where
  rnf :: EventDestination -> ()
rnf EventDestination' {[EventType]
Maybe Bool
Maybe CloudWatchDestination
Maybe KinesisFirehoseDestination
Maybe SNSDestination
Text
matchingEventTypes :: [EventType]
name :: Text
sNSDestination :: Maybe SNSDestination
kinesisFirehoseDestination :: Maybe KinesisFirehoseDestination
enabled :: Maybe Bool
cloudWatchDestination :: Maybe CloudWatchDestination
$sel:matchingEventTypes:EventDestination' :: EventDestination -> [EventType]
$sel:name:EventDestination' :: EventDestination -> Text
$sel:sNSDestination:EventDestination' :: EventDestination -> Maybe SNSDestination
$sel:kinesisFirehoseDestination:EventDestination' :: EventDestination -> Maybe KinesisFirehoseDestination
$sel:enabled:EventDestination' :: EventDestination -> Maybe Bool
$sel:cloudWatchDestination:EventDestination' :: EventDestination -> Maybe CloudWatchDestination
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe CloudWatchDestination
cloudWatchDestination
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Bool
enabled
      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
name
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf [EventType]
matchingEventTypes

instance Data.ToQuery EventDestination where
  toQuery :: EventDestination -> QueryString
toQuery EventDestination' {[EventType]
Maybe Bool
Maybe CloudWatchDestination
Maybe KinesisFirehoseDestination
Maybe SNSDestination
Text
matchingEventTypes :: [EventType]
name :: Text
sNSDestination :: Maybe SNSDestination
kinesisFirehoseDestination :: Maybe KinesisFirehoseDestination
enabled :: Maybe Bool
cloudWatchDestination :: Maybe CloudWatchDestination
$sel:matchingEventTypes:EventDestination' :: EventDestination -> [EventType]
$sel:name:EventDestination' :: EventDestination -> Text
$sel:sNSDestination:EventDestination' :: EventDestination -> Maybe SNSDestination
$sel:kinesisFirehoseDestination:EventDestination' :: EventDestination -> Maybe KinesisFirehoseDestination
$sel:enabled:EventDestination' :: EventDestination -> Maybe Bool
$sel:cloudWatchDestination:EventDestination' :: EventDestination -> Maybe CloudWatchDestination
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"CloudWatchDestination"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe CloudWatchDestination
cloudWatchDestination,
        ByteString
"Enabled" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Bool
enabled,
        ByteString
"KinesisFirehoseDestination"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe KinesisFirehoseDestination
kinesisFirehoseDestination,
        ByteString
"SNSDestination" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe SNSDestination
sNSDestination,
        ByteString
"Name" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Text
name,
        ByteString
"MatchingEventTypes"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: forall a.
(IsList a, ToQuery (Item a)) =>
ByteString -> a -> QueryString
Data.toQueryList ByteString
"member" [EventType]
matchingEventTypes
      ]