{-# 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.AutoScaling.PutNotificationConfiguration
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Configures an Auto Scaling group to send notifications when specified
-- events take place. Subscribers to the specified topic can have messages
-- delivered to an endpoint such as a web server or an email address.
--
-- This configuration overwrites any existing configuration.
--
-- For more information, see
-- <https://docs.aws.amazon.com/autoscaling/ec2/userguide/ASGettingNotifications.html Getting Amazon SNS notifications when your Auto Scaling group scales>
-- in the /Amazon EC2 Auto Scaling User Guide/.
--
-- If you exceed your maximum limit of SNS topics, which is 10 per Auto
-- Scaling group, the call fails.
module Amazonka.AutoScaling.PutNotificationConfiguration
  ( -- * Creating a Request
    PutNotificationConfiguration (..),
    newPutNotificationConfiguration,

    -- * Request Lenses
    putNotificationConfiguration_autoScalingGroupName,
    putNotificationConfiguration_topicARN,
    putNotificationConfiguration_notificationTypes,

    -- * Destructuring the Response
    PutNotificationConfigurationResponse (..),
    newPutNotificationConfigurationResponse,
  )
where

import Amazonka.AutoScaling.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:/ 'newPutNotificationConfiguration' smart constructor.
data PutNotificationConfiguration = PutNotificationConfiguration'
  { -- | The name of the Auto Scaling group.
    PutNotificationConfiguration -> Text
autoScalingGroupName :: Prelude.Text,
    -- | The Amazon Resource Name (ARN) of the Amazon SNS topic.
    PutNotificationConfiguration -> Text
topicARN :: Prelude.Text,
    -- | The type of event that causes the notification to be sent. To query the
    -- notification types supported by Amazon EC2 Auto Scaling, call the
    -- DescribeAutoScalingNotificationTypes API.
    PutNotificationConfiguration -> [Text]
notificationTypes :: [Prelude.Text]
  }
  deriving (PutNotificationConfiguration
-> PutNotificationConfiguration -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PutNotificationConfiguration
-> PutNotificationConfiguration -> Bool
$c/= :: PutNotificationConfiguration
-> PutNotificationConfiguration -> Bool
== :: PutNotificationConfiguration
-> PutNotificationConfiguration -> Bool
$c== :: PutNotificationConfiguration
-> PutNotificationConfiguration -> Bool
Prelude.Eq, ReadPrec [PutNotificationConfiguration]
ReadPrec PutNotificationConfiguration
Int -> ReadS PutNotificationConfiguration
ReadS [PutNotificationConfiguration]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [PutNotificationConfiguration]
$creadListPrec :: ReadPrec [PutNotificationConfiguration]
readPrec :: ReadPrec PutNotificationConfiguration
$creadPrec :: ReadPrec PutNotificationConfiguration
readList :: ReadS [PutNotificationConfiguration]
$creadList :: ReadS [PutNotificationConfiguration]
readsPrec :: Int -> ReadS PutNotificationConfiguration
$creadsPrec :: Int -> ReadS PutNotificationConfiguration
Prelude.Read, Int -> PutNotificationConfiguration -> ShowS
[PutNotificationConfiguration] -> ShowS
PutNotificationConfiguration -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PutNotificationConfiguration] -> ShowS
$cshowList :: [PutNotificationConfiguration] -> ShowS
show :: PutNotificationConfiguration -> String
$cshow :: PutNotificationConfiguration -> String
showsPrec :: Int -> PutNotificationConfiguration -> ShowS
$cshowsPrec :: Int -> PutNotificationConfiguration -> ShowS
Prelude.Show, forall x.
Rep PutNotificationConfiguration x -> PutNotificationConfiguration
forall x.
PutNotificationConfiguration -> Rep PutNotificationConfiguration x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep PutNotificationConfiguration x -> PutNotificationConfiguration
$cfrom :: forall x.
PutNotificationConfiguration -> Rep PutNotificationConfiguration x
Prelude.Generic)

-- |
-- Create a value of 'PutNotificationConfiguration' 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:
--
-- 'autoScalingGroupName', 'putNotificationConfiguration_autoScalingGroupName' - The name of the Auto Scaling group.
--
-- 'topicARN', 'putNotificationConfiguration_topicARN' - The Amazon Resource Name (ARN) of the Amazon SNS topic.
--
-- 'notificationTypes', 'putNotificationConfiguration_notificationTypes' - The type of event that causes the notification to be sent. To query the
-- notification types supported by Amazon EC2 Auto Scaling, call the
-- DescribeAutoScalingNotificationTypes API.
newPutNotificationConfiguration ::
  -- | 'autoScalingGroupName'
  Prelude.Text ->
  -- | 'topicARN'
  Prelude.Text ->
  PutNotificationConfiguration
newPutNotificationConfiguration :: Text -> Text -> PutNotificationConfiguration
newPutNotificationConfiguration
  Text
pAutoScalingGroupName_
  Text
pTopicARN_ =
    PutNotificationConfiguration'
      { $sel:autoScalingGroupName:PutNotificationConfiguration' :: Text
autoScalingGroupName =
          Text
pAutoScalingGroupName_,
        $sel:topicARN:PutNotificationConfiguration' :: Text
topicARN = Text
pTopicARN_,
        $sel:notificationTypes:PutNotificationConfiguration' :: [Text]
notificationTypes = forall a. Monoid a => a
Prelude.mempty
      }

-- | The name of the Auto Scaling group.
putNotificationConfiguration_autoScalingGroupName :: Lens.Lens' PutNotificationConfiguration Prelude.Text
putNotificationConfiguration_autoScalingGroupName :: Lens' PutNotificationConfiguration Text
putNotificationConfiguration_autoScalingGroupName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PutNotificationConfiguration' {Text
autoScalingGroupName :: Text
$sel:autoScalingGroupName:PutNotificationConfiguration' :: PutNotificationConfiguration -> Text
autoScalingGroupName} -> Text
autoScalingGroupName) (\s :: PutNotificationConfiguration
s@PutNotificationConfiguration' {} Text
a -> PutNotificationConfiguration
s {$sel:autoScalingGroupName:PutNotificationConfiguration' :: Text
autoScalingGroupName = Text
a} :: PutNotificationConfiguration)

-- | The Amazon Resource Name (ARN) of the Amazon SNS topic.
putNotificationConfiguration_topicARN :: Lens.Lens' PutNotificationConfiguration Prelude.Text
putNotificationConfiguration_topicARN :: Lens' PutNotificationConfiguration Text
putNotificationConfiguration_topicARN = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PutNotificationConfiguration' {Text
topicARN :: Text
$sel:topicARN:PutNotificationConfiguration' :: PutNotificationConfiguration -> Text
topicARN} -> Text
topicARN) (\s :: PutNotificationConfiguration
s@PutNotificationConfiguration' {} Text
a -> PutNotificationConfiguration
s {$sel:topicARN:PutNotificationConfiguration' :: Text
topicARN = Text
a} :: PutNotificationConfiguration)

-- | The type of event that causes the notification to be sent. To query the
-- notification types supported by Amazon EC2 Auto Scaling, call the
-- DescribeAutoScalingNotificationTypes API.
putNotificationConfiguration_notificationTypes :: Lens.Lens' PutNotificationConfiguration [Prelude.Text]
putNotificationConfiguration_notificationTypes :: Lens' PutNotificationConfiguration [Text]
putNotificationConfiguration_notificationTypes = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PutNotificationConfiguration' {[Text]
notificationTypes :: [Text]
$sel:notificationTypes:PutNotificationConfiguration' :: PutNotificationConfiguration -> [Text]
notificationTypes} -> [Text]
notificationTypes) (\s :: PutNotificationConfiguration
s@PutNotificationConfiguration' {} [Text]
a -> PutNotificationConfiguration
s {$sel:notificationTypes:PutNotificationConfiguration' :: [Text]
notificationTypes = [Text]
a} :: PutNotificationConfiguration) 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 PutNotificationConfiguration where
  type
    AWSResponse PutNotificationConfiguration =
      PutNotificationConfigurationResponse
  request :: (Service -> Service)
-> PutNotificationConfiguration
-> Request PutNotificationConfiguration
request Service -> Service
overrides =
    forall a. ToRequest a => Service -> a -> Request a
Request.postQuery (Service -> Service
overrides Service
defaultService)
  response :: forall (m :: * -> *).
MonadResource m =>
(ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy PutNotificationConfiguration
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse PutNotificationConfiguration)))
response =
    forall (m :: * -> *) a.
MonadResource m =>
AWSResponse a
-> (ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy a
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse a)))
Response.receiveNull
      PutNotificationConfigurationResponse
PutNotificationConfigurationResponse'

instance
  Prelude.Hashable
    PutNotificationConfiguration
  where
  hashWithSalt :: Int -> PutNotificationConfiguration -> Int
hashWithSalt Int
_salt PutNotificationConfiguration' {[Text]
Text
notificationTypes :: [Text]
topicARN :: Text
autoScalingGroupName :: Text
$sel:notificationTypes:PutNotificationConfiguration' :: PutNotificationConfiguration -> [Text]
$sel:topicARN:PutNotificationConfiguration' :: PutNotificationConfiguration -> Text
$sel:autoScalingGroupName:PutNotificationConfiguration' :: PutNotificationConfiguration -> Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
autoScalingGroupName
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
topicARN
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` [Text]
notificationTypes

instance Prelude.NFData PutNotificationConfiguration where
  rnf :: PutNotificationConfiguration -> ()
rnf PutNotificationConfiguration' {[Text]
Text
notificationTypes :: [Text]
topicARN :: Text
autoScalingGroupName :: Text
$sel:notificationTypes:PutNotificationConfiguration' :: PutNotificationConfiguration -> [Text]
$sel:topicARN:PutNotificationConfiguration' :: PutNotificationConfiguration -> Text
$sel:autoScalingGroupName:PutNotificationConfiguration' :: PutNotificationConfiguration -> Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Text
autoScalingGroupName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
topicARN
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf [Text]
notificationTypes

instance Data.ToHeaders PutNotificationConfiguration where
  toHeaders :: PutNotificationConfiguration -> [Header]
toHeaders = forall a b. a -> b -> a
Prelude.const forall a. Monoid a => a
Prelude.mempty

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

instance Data.ToQuery PutNotificationConfiguration where
  toQuery :: PutNotificationConfiguration -> QueryString
toQuery PutNotificationConfiguration' {[Text]
Text
notificationTypes :: [Text]
topicARN :: Text
autoScalingGroupName :: Text
$sel:notificationTypes:PutNotificationConfiguration' :: PutNotificationConfiguration -> [Text]
$sel:topicARN:PutNotificationConfiguration' :: PutNotificationConfiguration -> Text
$sel:autoScalingGroupName:PutNotificationConfiguration' :: PutNotificationConfiguration -> Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"Action"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: ( ByteString
"PutNotificationConfiguration" ::
                      Prelude.ByteString
                  ),
        ByteString
"Version"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: (ByteString
"2011-01-01" :: Prelude.ByteString),
        ByteString
"AutoScalingGroupName" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Text
autoScalingGroupName,
        ByteString
"TopicARN" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Text
topicARN,
        ByteString
"NotificationTypes"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: forall a.
(IsList a, ToQuery (Item a)) =>
ByteString -> a -> QueryString
Data.toQueryList ByteString
"member" [Text]
notificationTypes
      ]

-- | /See:/ 'newPutNotificationConfigurationResponse' smart constructor.
data PutNotificationConfigurationResponse = PutNotificationConfigurationResponse'
  {
  }
  deriving (PutNotificationConfigurationResponse
-> PutNotificationConfigurationResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PutNotificationConfigurationResponse
-> PutNotificationConfigurationResponse -> Bool
$c/= :: PutNotificationConfigurationResponse
-> PutNotificationConfigurationResponse -> Bool
== :: PutNotificationConfigurationResponse
-> PutNotificationConfigurationResponse -> Bool
$c== :: PutNotificationConfigurationResponse
-> PutNotificationConfigurationResponse -> Bool
Prelude.Eq, ReadPrec [PutNotificationConfigurationResponse]
ReadPrec PutNotificationConfigurationResponse
Int -> ReadS PutNotificationConfigurationResponse
ReadS [PutNotificationConfigurationResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [PutNotificationConfigurationResponse]
$creadListPrec :: ReadPrec [PutNotificationConfigurationResponse]
readPrec :: ReadPrec PutNotificationConfigurationResponse
$creadPrec :: ReadPrec PutNotificationConfigurationResponse
readList :: ReadS [PutNotificationConfigurationResponse]
$creadList :: ReadS [PutNotificationConfigurationResponse]
readsPrec :: Int -> ReadS PutNotificationConfigurationResponse
$creadsPrec :: Int -> ReadS PutNotificationConfigurationResponse
Prelude.Read, Int -> PutNotificationConfigurationResponse -> ShowS
[PutNotificationConfigurationResponse] -> ShowS
PutNotificationConfigurationResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PutNotificationConfigurationResponse] -> ShowS
$cshowList :: [PutNotificationConfigurationResponse] -> ShowS
show :: PutNotificationConfigurationResponse -> String
$cshow :: PutNotificationConfigurationResponse -> String
showsPrec :: Int -> PutNotificationConfigurationResponse -> ShowS
$cshowsPrec :: Int -> PutNotificationConfigurationResponse -> ShowS
Prelude.Show, forall x.
Rep PutNotificationConfigurationResponse x
-> PutNotificationConfigurationResponse
forall x.
PutNotificationConfigurationResponse
-> Rep PutNotificationConfigurationResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep PutNotificationConfigurationResponse x
-> PutNotificationConfigurationResponse
$cfrom :: forall x.
PutNotificationConfigurationResponse
-> Rep PutNotificationConfigurationResponse x
Prelude.Generic)

-- |
-- Create a value of 'PutNotificationConfigurationResponse' 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.
newPutNotificationConfigurationResponse ::
  PutNotificationConfigurationResponse
newPutNotificationConfigurationResponse :: PutNotificationConfigurationResponse
newPutNotificationConfigurationResponse =
  PutNotificationConfigurationResponse
PutNotificationConfigurationResponse'

instance
  Prelude.NFData
    PutNotificationConfigurationResponse
  where
  rnf :: PutNotificationConfigurationResponse -> ()
rnf PutNotificationConfigurationResponse
_ = ()