{-# 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.EC2.Types.ConnectionNotification
-- 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.EC2.Types.ConnectionNotification where

import qualified Amazonka.Core as Core
import qualified Amazonka.Core.Lens.Internal as Lens
import qualified Amazonka.Data as Data
import Amazonka.EC2.Internal
import Amazonka.EC2.Types.ConnectionNotificationState
import Amazonka.EC2.Types.ConnectionNotificationType
import qualified Amazonka.Prelude as Prelude

-- | Describes a connection notification for a VPC endpoint or VPC endpoint
-- service.
--
-- /See:/ 'newConnectionNotification' smart constructor.
data ConnectionNotification = ConnectionNotification'
  { -- | The events for the notification. Valid values are @Accept@, @Connect@,
    -- @Delete@, and @Reject@.
    ConnectionNotification -> Maybe [Text]
connectionEvents :: Prelude.Maybe [Prelude.Text],
    -- | The ARN of the SNS topic for the notification.
    ConnectionNotification -> Maybe Text
connectionNotificationArn :: Prelude.Maybe Prelude.Text,
    -- | The ID of the notification.
    ConnectionNotification -> Maybe Text
connectionNotificationId :: Prelude.Maybe Prelude.Text,
    -- | The state of the notification.
    ConnectionNotification -> Maybe ConnectionNotificationState
connectionNotificationState :: Prelude.Maybe ConnectionNotificationState,
    -- | The type of notification.
    ConnectionNotification -> Maybe ConnectionNotificationType
connectionNotificationType :: Prelude.Maybe ConnectionNotificationType,
    -- | The ID of the endpoint service.
    ConnectionNotification -> Maybe Text
serviceId :: Prelude.Maybe Prelude.Text,
    -- | The ID of the VPC endpoint.
    ConnectionNotification -> Maybe Text
vpcEndpointId :: Prelude.Maybe Prelude.Text
  }
  deriving (ConnectionNotification -> ConnectionNotification -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ConnectionNotification -> ConnectionNotification -> Bool
$c/= :: ConnectionNotification -> ConnectionNotification -> Bool
== :: ConnectionNotification -> ConnectionNotification -> Bool
$c== :: ConnectionNotification -> ConnectionNotification -> Bool
Prelude.Eq, ReadPrec [ConnectionNotification]
ReadPrec ConnectionNotification
Int -> ReadS ConnectionNotification
ReadS [ConnectionNotification]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ConnectionNotification]
$creadListPrec :: ReadPrec [ConnectionNotification]
readPrec :: ReadPrec ConnectionNotification
$creadPrec :: ReadPrec ConnectionNotification
readList :: ReadS [ConnectionNotification]
$creadList :: ReadS [ConnectionNotification]
readsPrec :: Int -> ReadS ConnectionNotification
$creadsPrec :: Int -> ReadS ConnectionNotification
Prelude.Read, Int -> ConnectionNotification -> ShowS
[ConnectionNotification] -> ShowS
ConnectionNotification -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ConnectionNotification] -> ShowS
$cshowList :: [ConnectionNotification] -> ShowS
show :: ConnectionNotification -> String
$cshow :: ConnectionNotification -> String
showsPrec :: Int -> ConnectionNotification -> ShowS
$cshowsPrec :: Int -> ConnectionNotification -> ShowS
Prelude.Show, forall x. Rep ConnectionNotification x -> ConnectionNotification
forall x. ConnectionNotification -> Rep ConnectionNotification x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ConnectionNotification x -> ConnectionNotification
$cfrom :: forall x. ConnectionNotification -> Rep ConnectionNotification x
Prelude.Generic)

-- |
-- Create a value of 'ConnectionNotification' 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:
--
-- 'connectionEvents', 'connectionNotification_connectionEvents' - The events for the notification. Valid values are @Accept@, @Connect@,
-- @Delete@, and @Reject@.
--
-- 'connectionNotificationArn', 'connectionNotification_connectionNotificationArn' - The ARN of the SNS topic for the notification.
--
-- 'connectionNotificationId', 'connectionNotification_connectionNotificationId' - The ID of the notification.
--
-- 'connectionNotificationState', 'connectionNotification_connectionNotificationState' - The state of the notification.
--
-- 'connectionNotificationType', 'connectionNotification_connectionNotificationType' - The type of notification.
--
-- 'serviceId', 'connectionNotification_serviceId' - The ID of the endpoint service.
--
-- 'vpcEndpointId', 'connectionNotification_vpcEndpointId' - The ID of the VPC endpoint.
newConnectionNotification ::
  ConnectionNotification
newConnectionNotification :: ConnectionNotification
newConnectionNotification =
  ConnectionNotification'
    { $sel:connectionEvents:ConnectionNotification' :: Maybe [Text]
connectionEvents =
        forall a. Maybe a
Prelude.Nothing,
      $sel:connectionNotificationArn:ConnectionNotification' :: Maybe Text
connectionNotificationArn = forall a. Maybe a
Prelude.Nothing,
      $sel:connectionNotificationId:ConnectionNotification' :: Maybe Text
connectionNotificationId = forall a. Maybe a
Prelude.Nothing,
      $sel:connectionNotificationState:ConnectionNotification' :: Maybe ConnectionNotificationState
connectionNotificationState = forall a. Maybe a
Prelude.Nothing,
      $sel:connectionNotificationType:ConnectionNotification' :: Maybe ConnectionNotificationType
connectionNotificationType = forall a. Maybe a
Prelude.Nothing,
      $sel:serviceId:ConnectionNotification' :: Maybe Text
serviceId = forall a. Maybe a
Prelude.Nothing,
      $sel:vpcEndpointId:ConnectionNotification' :: Maybe Text
vpcEndpointId = forall a. Maybe a
Prelude.Nothing
    }

-- | The events for the notification. Valid values are @Accept@, @Connect@,
-- @Delete@, and @Reject@.
connectionNotification_connectionEvents :: Lens.Lens' ConnectionNotification (Prelude.Maybe [Prelude.Text])
connectionNotification_connectionEvents :: Lens' ConnectionNotification (Maybe [Text])
connectionNotification_connectionEvents = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ConnectionNotification' {Maybe [Text]
connectionEvents :: Maybe [Text]
$sel:connectionEvents:ConnectionNotification' :: ConnectionNotification -> Maybe [Text]
connectionEvents} -> Maybe [Text]
connectionEvents) (\s :: ConnectionNotification
s@ConnectionNotification' {} Maybe [Text]
a -> ConnectionNotification
s {$sel:connectionEvents:ConnectionNotification' :: Maybe [Text]
connectionEvents = Maybe [Text]
a} :: ConnectionNotification) 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 ARN of the SNS topic for the notification.
connectionNotification_connectionNotificationArn :: Lens.Lens' ConnectionNotification (Prelude.Maybe Prelude.Text)
connectionNotification_connectionNotificationArn :: Lens' ConnectionNotification (Maybe Text)
connectionNotification_connectionNotificationArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ConnectionNotification' {Maybe Text
connectionNotificationArn :: Maybe Text
$sel:connectionNotificationArn:ConnectionNotification' :: ConnectionNotification -> Maybe Text
connectionNotificationArn} -> Maybe Text
connectionNotificationArn) (\s :: ConnectionNotification
s@ConnectionNotification' {} Maybe Text
a -> ConnectionNotification
s {$sel:connectionNotificationArn:ConnectionNotification' :: Maybe Text
connectionNotificationArn = Maybe Text
a} :: ConnectionNotification)

-- | The ID of the notification.
connectionNotification_connectionNotificationId :: Lens.Lens' ConnectionNotification (Prelude.Maybe Prelude.Text)
connectionNotification_connectionNotificationId :: Lens' ConnectionNotification (Maybe Text)
connectionNotification_connectionNotificationId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ConnectionNotification' {Maybe Text
connectionNotificationId :: Maybe Text
$sel:connectionNotificationId:ConnectionNotification' :: ConnectionNotification -> Maybe Text
connectionNotificationId} -> Maybe Text
connectionNotificationId) (\s :: ConnectionNotification
s@ConnectionNotification' {} Maybe Text
a -> ConnectionNotification
s {$sel:connectionNotificationId:ConnectionNotification' :: Maybe Text
connectionNotificationId = Maybe Text
a} :: ConnectionNotification)

-- | The state of the notification.
connectionNotification_connectionNotificationState :: Lens.Lens' ConnectionNotification (Prelude.Maybe ConnectionNotificationState)
connectionNotification_connectionNotificationState :: Lens' ConnectionNotification (Maybe ConnectionNotificationState)
connectionNotification_connectionNotificationState = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ConnectionNotification' {Maybe ConnectionNotificationState
connectionNotificationState :: Maybe ConnectionNotificationState
$sel:connectionNotificationState:ConnectionNotification' :: ConnectionNotification -> Maybe ConnectionNotificationState
connectionNotificationState} -> Maybe ConnectionNotificationState
connectionNotificationState) (\s :: ConnectionNotification
s@ConnectionNotification' {} Maybe ConnectionNotificationState
a -> ConnectionNotification
s {$sel:connectionNotificationState:ConnectionNotification' :: Maybe ConnectionNotificationState
connectionNotificationState = Maybe ConnectionNotificationState
a} :: ConnectionNotification)

-- | The type of notification.
connectionNotification_connectionNotificationType :: Lens.Lens' ConnectionNotification (Prelude.Maybe ConnectionNotificationType)
connectionNotification_connectionNotificationType :: Lens' ConnectionNotification (Maybe ConnectionNotificationType)
connectionNotification_connectionNotificationType = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ConnectionNotification' {Maybe ConnectionNotificationType
connectionNotificationType :: Maybe ConnectionNotificationType
$sel:connectionNotificationType:ConnectionNotification' :: ConnectionNotification -> Maybe ConnectionNotificationType
connectionNotificationType} -> Maybe ConnectionNotificationType
connectionNotificationType) (\s :: ConnectionNotification
s@ConnectionNotification' {} Maybe ConnectionNotificationType
a -> ConnectionNotification
s {$sel:connectionNotificationType:ConnectionNotification' :: Maybe ConnectionNotificationType
connectionNotificationType = Maybe ConnectionNotificationType
a} :: ConnectionNotification)

-- | The ID of the endpoint service.
connectionNotification_serviceId :: Lens.Lens' ConnectionNotification (Prelude.Maybe Prelude.Text)
connectionNotification_serviceId :: Lens' ConnectionNotification (Maybe Text)
connectionNotification_serviceId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ConnectionNotification' {Maybe Text
serviceId :: Maybe Text
$sel:serviceId:ConnectionNotification' :: ConnectionNotification -> Maybe Text
serviceId} -> Maybe Text
serviceId) (\s :: ConnectionNotification
s@ConnectionNotification' {} Maybe Text
a -> ConnectionNotification
s {$sel:serviceId:ConnectionNotification' :: Maybe Text
serviceId = Maybe Text
a} :: ConnectionNotification)

-- | The ID of the VPC endpoint.
connectionNotification_vpcEndpointId :: Lens.Lens' ConnectionNotification (Prelude.Maybe Prelude.Text)
connectionNotification_vpcEndpointId :: Lens' ConnectionNotification (Maybe Text)
connectionNotification_vpcEndpointId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ConnectionNotification' {Maybe Text
vpcEndpointId :: Maybe Text
$sel:vpcEndpointId:ConnectionNotification' :: ConnectionNotification -> Maybe Text
vpcEndpointId} -> Maybe Text
vpcEndpointId) (\s :: ConnectionNotification
s@ConnectionNotification' {} Maybe Text
a -> ConnectionNotification
s {$sel:vpcEndpointId:ConnectionNotification' :: Maybe Text
vpcEndpointId = Maybe Text
a} :: ConnectionNotification)

instance Data.FromXML ConnectionNotification where
  parseXML :: [Node] -> Either String ConnectionNotification
parseXML [Node]
x =
    Maybe [Text]
-> Maybe Text
-> Maybe Text
-> Maybe ConnectionNotificationState
-> Maybe ConnectionNotificationType
-> Maybe Text
-> Maybe Text
-> ConnectionNotification
ConnectionNotification'
      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
"connectionEvents"
                      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 (f :: * -> *) a b.
Applicative f =>
([a] -> f b) -> [a] -> f (Maybe b)
Core.may (forall a. FromXML a => Text -> [Node] -> Either String [a]
Data.parseXMLList Text
"item")
                  )
      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
"connectionNotificationArn")
      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
"connectionNotificationId")
      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
"connectionNotificationState")
      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
"connectionNotificationType")
      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
"serviceId")
      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
"vpcEndpointId")

instance Prelude.Hashable ConnectionNotification where
  hashWithSalt :: Int -> ConnectionNotification -> Int
hashWithSalt Int
_salt ConnectionNotification' {Maybe [Text]
Maybe Text
Maybe ConnectionNotificationState
Maybe ConnectionNotificationType
vpcEndpointId :: Maybe Text
serviceId :: Maybe Text
connectionNotificationType :: Maybe ConnectionNotificationType
connectionNotificationState :: Maybe ConnectionNotificationState
connectionNotificationId :: Maybe Text
connectionNotificationArn :: Maybe Text
connectionEvents :: Maybe [Text]
$sel:vpcEndpointId:ConnectionNotification' :: ConnectionNotification -> Maybe Text
$sel:serviceId:ConnectionNotification' :: ConnectionNotification -> Maybe Text
$sel:connectionNotificationType:ConnectionNotification' :: ConnectionNotification -> Maybe ConnectionNotificationType
$sel:connectionNotificationState:ConnectionNotification' :: ConnectionNotification -> Maybe ConnectionNotificationState
$sel:connectionNotificationId:ConnectionNotification' :: ConnectionNotification -> Maybe Text
$sel:connectionNotificationArn:ConnectionNotification' :: ConnectionNotification -> Maybe Text
$sel:connectionEvents:ConnectionNotification' :: ConnectionNotification -> Maybe [Text]
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [Text]
connectionEvents
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
connectionNotificationArn
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
connectionNotificationId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe ConnectionNotificationState
connectionNotificationState
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe ConnectionNotificationType
connectionNotificationType
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
serviceId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
vpcEndpointId

instance Prelude.NFData ConnectionNotification where
  rnf :: ConnectionNotification -> ()
rnf ConnectionNotification' {Maybe [Text]
Maybe Text
Maybe ConnectionNotificationState
Maybe ConnectionNotificationType
vpcEndpointId :: Maybe Text
serviceId :: Maybe Text
connectionNotificationType :: Maybe ConnectionNotificationType
connectionNotificationState :: Maybe ConnectionNotificationState
connectionNotificationId :: Maybe Text
connectionNotificationArn :: Maybe Text
connectionEvents :: Maybe [Text]
$sel:vpcEndpointId:ConnectionNotification' :: ConnectionNotification -> Maybe Text
$sel:serviceId:ConnectionNotification' :: ConnectionNotification -> Maybe Text
$sel:connectionNotificationType:ConnectionNotification' :: ConnectionNotification -> Maybe ConnectionNotificationType
$sel:connectionNotificationState:ConnectionNotification' :: ConnectionNotification -> Maybe ConnectionNotificationState
$sel:connectionNotificationId:ConnectionNotification' :: ConnectionNotification -> Maybe Text
$sel:connectionNotificationArn:ConnectionNotification' :: ConnectionNotification -> Maybe Text
$sel:connectionEvents:ConnectionNotification' :: ConnectionNotification -> Maybe [Text]
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe [Text]
connectionEvents
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
connectionNotificationArn
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
connectionNotificationId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe ConnectionNotificationState
connectionNotificationState
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe ConnectionNotificationType
connectionNotificationType
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
serviceId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
vpcEndpointId