{-# 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.IoTEvents.Types.NotificationAction
-- 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.IoTEvents.Types.NotificationAction where

import qualified Amazonka.Core as Core
import qualified Amazonka.Core.Lens.Internal as Lens
import qualified Amazonka.Data as Data
import Amazonka.IoTEvents.Types.EmailConfiguration
import Amazonka.IoTEvents.Types.NotificationTargetActions
import Amazonka.IoTEvents.Types.SMSConfiguration
import qualified Amazonka.Prelude as Prelude

-- | Contains the notification settings of an alarm model. The settings apply
-- to all alarms that were created based on this alarm model.
--
-- /See:/ 'newNotificationAction' smart constructor.
data NotificationAction = NotificationAction'
  { -- | Contains the configuration information of email notifications.
    NotificationAction -> Maybe (NonEmpty EmailConfiguration)
emailConfigurations :: Prelude.Maybe (Prelude.NonEmpty EmailConfiguration),
    -- | Contains the configuration information of SMS notifications.
    NotificationAction -> Maybe (NonEmpty SMSConfiguration)
smsConfigurations :: Prelude.Maybe (Prelude.NonEmpty SMSConfiguration),
    -- | Specifies an AWS Lambda function to manage alarm notifications. You can
    -- create one or use the
    -- <https://docs.aws.amazon.com/iotevents/latest/developerguide/lambda-support.html AWS Lambda function provided by AWS IoT Events>.
    NotificationAction -> NotificationTargetActions
action :: NotificationTargetActions
  }
  deriving (NotificationAction -> NotificationAction -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: NotificationAction -> NotificationAction -> Bool
$c/= :: NotificationAction -> NotificationAction -> Bool
== :: NotificationAction -> NotificationAction -> Bool
$c== :: NotificationAction -> NotificationAction -> Bool
Prelude.Eq, ReadPrec [NotificationAction]
ReadPrec NotificationAction
Int -> ReadS NotificationAction
ReadS [NotificationAction]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [NotificationAction]
$creadListPrec :: ReadPrec [NotificationAction]
readPrec :: ReadPrec NotificationAction
$creadPrec :: ReadPrec NotificationAction
readList :: ReadS [NotificationAction]
$creadList :: ReadS [NotificationAction]
readsPrec :: Int -> ReadS NotificationAction
$creadsPrec :: Int -> ReadS NotificationAction
Prelude.Read, Int -> NotificationAction -> ShowS
[NotificationAction] -> ShowS
NotificationAction -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [NotificationAction] -> ShowS
$cshowList :: [NotificationAction] -> ShowS
show :: NotificationAction -> String
$cshow :: NotificationAction -> String
showsPrec :: Int -> NotificationAction -> ShowS
$cshowsPrec :: Int -> NotificationAction -> ShowS
Prelude.Show, forall x. Rep NotificationAction x -> NotificationAction
forall x. NotificationAction -> Rep NotificationAction x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep NotificationAction x -> NotificationAction
$cfrom :: forall x. NotificationAction -> Rep NotificationAction x
Prelude.Generic)

-- |
-- Create a value of 'NotificationAction' 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:
--
-- 'emailConfigurations', 'notificationAction_emailConfigurations' - Contains the configuration information of email notifications.
--
-- 'smsConfigurations', 'notificationAction_smsConfigurations' - Contains the configuration information of SMS notifications.
--
-- 'action', 'notificationAction_action' - Specifies an AWS Lambda function to manage alarm notifications. You can
-- create one or use the
-- <https://docs.aws.amazon.com/iotevents/latest/developerguide/lambda-support.html AWS Lambda function provided by AWS IoT Events>.
newNotificationAction ::
  -- | 'action'
  NotificationTargetActions ->
  NotificationAction
newNotificationAction :: NotificationTargetActions -> NotificationAction
newNotificationAction NotificationTargetActions
pAction_ =
  NotificationAction'
    { $sel:emailConfigurations:NotificationAction' :: Maybe (NonEmpty EmailConfiguration)
emailConfigurations =
        forall a. Maybe a
Prelude.Nothing,
      $sel:smsConfigurations:NotificationAction' :: Maybe (NonEmpty SMSConfiguration)
smsConfigurations = forall a. Maybe a
Prelude.Nothing,
      $sel:action:NotificationAction' :: NotificationTargetActions
action = NotificationTargetActions
pAction_
    }

-- | Contains the configuration information of email notifications.
notificationAction_emailConfigurations :: Lens.Lens' NotificationAction (Prelude.Maybe (Prelude.NonEmpty EmailConfiguration))
notificationAction_emailConfigurations :: Lens' NotificationAction (Maybe (NonEmpty EmailConfiguration))
notificationAction_emailConfigurations = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\NotificationAction' {Maybe (NonEmpty EmailConfiguration)
emailConfigurations :: Maybe (NonEmpty EmailConfiguration)
$sel:emailConfigurations:NotificationAction' :: NotificationAction -> Maybe (NonEmpty EmailConfiguration)
emailConfigurations} -> Maybe (NonEmpty EmailConfiguration)
emailConfigurations) (\s :: NotificationAction
s@NotificationAction' {} Maybe (NonEmpty EmailConfiguration)
a -> NotificationAction
s {$sel:emailConfigurations:NotificationAction' :: Maybe (NonEmpty EmailConfiguration)
emailConfigurations = Maybe (NonEmpty EmailConfiguration)
a} :: NotificationAction) 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

-- | Contains the configuration information of SMS notifications.
notificationAction_smsConfigurations :: Lens.Lens' NotificationAction (Prelude.Maybe (Prelude.NonEmpty SMSConfiguration))
notificationAction_smsConfigurations :: Lens' NotificationAction (Maybe (NonEmpty SMSConfiguration))
notificationAction_smsConfigurations = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\NotificationAction' {Maybe (NonEmpty SMSConfiguration)
smsConfigurations :: Maybe (NonEmpty SMSConfiguration)
$sel:smsConfigurations:NotificationAction' :: NotificationAction -> Maybe (NonEmpty SMSConfiguration)
smsConfigurations} -> Maybe (NonEmpty SMSConfiguration)
smsConfigurations) (\s :: NotificationAction
s@NotificationAction' {} Maybe (NonEmpty SMSConfiguration)
a -> NotificationAction
s {$sel:smsConfigurations:NotificationAction' :: Maybe (NonEmpty SMSConfiguration)
smsConfigurations = Maybe (NonEmpty SMSConfiguration)
a} :: NotificationAction) 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

-- | Specifies an AWS Lambda function to manage alarm notifications. You can
-- create one or use the
-- <https://docs.aws.amazon.com/iotevents/latest/developerguide/lambda-support.html AWS Lambda function provided by AWS IoT Events>.
notificationAction_action :: Lens.Lens' NotificationAction NotificationTargetActions
notificationAction_action :: Lens' NotificationAction NotificationTargetActions
notificationAction_action = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\NotificationAction' {NotificationTargetActions
action :: NotificationTargetActions
$sel:action:NotificationAction' :: NotificationAction -> NotificationTargetActions
action} -> NotificationTargetActions
action) (\s :: NotificationAction
s@NotificationAction' {} NotificationTargetActions
a -> NotificationAction
s {$sel:action:NotificationAction' :: NotificationTargetActions
action = NotificationTargetActions
a} :: NotificationAction)

instance Data.FromJSON NotificationAction where
  parseJSON :: Value -> Parser NotificationAction
parseJSON =
    forall a. String -> (Object -> Parser a) -> Value -> Parser a
Data.withObject
      String
"NotificationAction"
      ( \Object
x ->
          Maybe (NonEmpty EmailConfiguration)
-> Maybe (NonEmpty SMSConfiguration)
-> NotificationTargetActions
-> NotificationAction
NotificationAction'
            forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> (Object
x forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data..:? Key
"emailConfigurations")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data..:? Key
"smsConfigurations")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser a
Data..: Key
"action")
      )

instance Prelude.Hashable NotificationAction where
  hashWithSalt :: Int -> NotificationAction -> Int
hashWithSalt Int
_salt NotificationAction' {Maybe (NonEmpty SMSConfiguration)
Maybe (NonEmpty EmailConfiguration)
NotificationTargetActions
action :: NotificationTargetActions
smsConfigurations :: Maybe (NonEmpty SMSConfiguration)
emailConfigurations :: Maybe (NonEmpty EmailConfiguration)
$sel:action:NotificationAction' :: NotificationAction -> NotificationTargetActions
$sel:smsConfigurations:NotificationAction' :: NotificationAction -> Maybe (NonEmpty SMSConfiguration)
$sel:emailConfigurations:NotificationAction' :: NotificationAction -> Maybe (NonEmpty EmailConfiguration)
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe (NonEmpty EmailConfiguration)
emailConfigurations
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe (NonEmpty SMSConfiguration)
smsConfigurations
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` NotificationTargetActions
action

instance Prelude.NFData NotificationAction where
  rnf :: NotificationAction -> ()
rnf NotificationAction' {Maybe (NonEmpty SMSConfiguration)
Maybe (NonEmpty EmailConfiguration)
NotificationTargetActions
action :: NotificationTargetActions
smsConfigurations :: Maybe (NonEmpty SMSConfiguration)
emailConfigurations :: Maybe (NonEmpty EmailConfiguration)
$sel:action:NotificationAction' :: NotificationAction -> NotificationTargetActions
$sel:smsConfigurations:NotificationAction' :: NotificationAction -> Maybe (NonEmpty SMSConfiguration)
$sel:emailConfigurations:NotificationAction' :: NotificationAction -> Maybe (NonEmpty EmailConfiguration)
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe (NonEmpty EmailConfiguration)
emailConfigurations
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe (NonEmpty SMSConfiguration)
smsConfigurations
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf NotificationTargetActions
action

instance Data.ToJSON NotificationAction where
  toJSON :: NotificationAction -> Value
toJSON NotificationAction' {Maybe (NonEmpty SMSConfiguration)
Maybe (NonEmpty EmailConfiguration)
NotificationTargetActions
action :: NotificationTargetActions
smsConfigurations :: Maybe (NonEmpty SMSConfiguration)
emailConfigurations :: Maybe (NonEmpty EmailConfiguration)
$sel:action:NotificationAction' :: NotificationAction -> NotificationTargetActions
$sel:smsConfigurations:NotificationAction' :: NotificationAction -> Maybe (NonEmpty SMSConfiguration)
$sel:emailConfigurations:NotificationAction' :: NotificationAction -> Maybe (NonEmpty EmailConfiguration)
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"emailConfigurations" 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 (NonEmpty EmailConfiguration)
emailConfigurations,
            (Key
"smsConfigurations" 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 (NonEmpty SMSConfiguration)
smsConfigurations,
            forall a. a -> Maybe a
Prelude.Just (Key
"action" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= NotificationTargetActions
action)
          ]
      )