{-# 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.SSMContacts.Types.ContactChannel
-- 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.SSMContacts.Types.ContactChannel 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.SSMContacts.Types.ActivationStatus
import Amazonka.SSMContacts.Types.ChannelType
import Amazonka.SSMContacts.Types.ContactChannelAddress

-- | The method that Incident Manager uses to engage a contact.
--
-- /See:/ 'newContactChannel' smart constructor.
data ContactChannel = ContactChannel'
  { -- | The type of the contact channel. Incident Manager supports three contact
    -- methods:
    --
    -- -   SMS
    --
    -- -   VOICE
    --
    -- -   EMAIL
    ContactChannel -> Maybe ChannelType
type' :: Prelude.Maybe ChannelType,
    -- | The Amazon Resource Name (ARN) of the contact channel.
    ContactChannel -> Text
contactChannelArn :: Prelude.Text,
    -- | The ARN of the contact that contains the contact channel.
    ContactChannel -> Text
contactArn :: Prelude.Text,
    -- | The name of the contact channel.
    ContactChannel -> Text
name :: Prelude.Text,
    -- | The details that Incident Manager uses when trying to engage the contact
    -- channel.
    ContactChannel -> ContactChannelAddress
deliveryAddress :: ContactChannelAddress,
    -- | A Boolean value describing if the contact channel has been activated or
    -- not. If the contact channel isn\'t activated, Incident Manager can\'t
    -- engage the contact through it.
    ContactChannel -> ActivationStatus
activationStatus :: ActivationStatus
  }
  deriving (ContactChannel -> ContactChannel -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ContactChannel -> ContactChannel -> Bool
$c/= :: ContactChannel -> ContactChannel -> Bool
== :: ContactChannel -> ContactChannel -> Bool
$c== :: ContactChannel -> ContactChannel -> Bool
Prelude.Eq, ReadPrec [ContactChannel]
ReadPrec ContactChannel
Int -> ReadS ContactChannel
ReadS [ContactChannel]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ContactChannel]
$creadListPrec :: ReadPrec [ContactChannel]
readPrec :: ReadPrec ContactChannel
$creadPrec :: ReadPrec ContactChannel
readList :: ReadS [ContactChannel]
$creadList :: ReadS [ContactChannel]
readsPrec :: Int -> ReadS ContactChannel
$creadsPrec :: Int -> ReadS ContactChannel
Prelude.Read, Int -> ContactChannel -> ShowS
[ContactChannel] -> ShowS
ContactChannel -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ContactChannel] -> ShowS
$cshowList :: [ContactChannel] -> ShowS
show :: ContactChannel -> String
$cshow :: ContactChannel -> String
showsPrec :: Int -> ContactChannel -> ShowS
$cshowsPrec :: Int -> ContactChannel -> ShowS
Prelude.Show, forall x. Rep ContactChannel x -> ContactChannel
forall x. ContactChannel -> Rep ContactChannel x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ContactChannel x -> ContactChannel
$cfrom :: forall x. ContactChannel -> Rep ContactChannel x
Prelude.Generic)

-- |
-- Create a value of 'ContactChannel' 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:
--
-- 'type'', 'contactChannel_type' - The type of the contact channel. Incident Manager supports three contact
-- methods:
--
-- -   SMS
--
-- -   VOICE
--
-- -   EMAIL
--
-- 'contactChannelArn', 'contactChannel_contactChannelArn' - The Amazon Resource Name (ARN) of the contact channel.
--
-- 'contactArn', 'contactChannel_contactArn' - The ARN of the contact that contains the contact channel.
--
-- 'name', 'contactChannel_name' - The name of the contact channel.
--
-- 'deliveryAddress', 'contactChannel_deliveryAddress' - The details that Incident Manager uses when trying to engage the contact
-- channel.
--
-- 'activationStatus', 'contactChannel_activationStatus' - A Boolean value describing if the contact channel has been activated or
-- not. If the contact channel isn\'t activated, Incident Manager can\'t
-- engage the contact through it.
newContactChannel ::
  -- | 'contactChannelArn'
  Prelude.Text ->
  -- | 'contactArn'
  Prelude.Text ->
  -- | 'name'
  Prelude.Text ->
  -- | 'deliveryAddress'
  ContactChannelAddress ->
  -- | 'activationStatus'
  ActivationStatus ->
  ContactChannel
newContactChannel :: Text
-> Text
-> Text
-> ContactChannelAddress
-> ActivationStatus
-> ContactChannel
newContactChannel
  Text
pContactChannelArn_
  Text
pContactArn_
  Text
pName_
  ContactChannelAddress
pDeliveryAddress_
  ActivationStatus
pActivationStatus_ =
    ContactChannel'
      { $sel:type':ContactChannel' :: Maybe ChannelType
type' = forall a. Maybe a
Prelude.Nothing,
        $sel:contactChannelArn:ContactChannel' :: Text
contactChannelArn = Text
pContactChannelArn_,
        $sel:contactArn:ContactChannel' :: Text
contactArn = Text
pContactArn_,
        $sel:name:ContactChannel' :: Text
name = Text
pName_,
        $sel:deliveryAddress:ContactChannel' :: ContactChannelAddress
deliveryAddress = ContactChannelAddress
pDeliveryAddress_,
        $sel:activationStatus:ContactChannel' :: ActivationStatus
activationStatus = ActivationStatus
pActivationStatus_
      }

-- | The type of the contact channel. Incident Manager supports three contact
-- methods:
--
-- -   SMS
--
-- -   VOICE
--
-- -   EMAIL
contactChannel_type :: Lens.Lens' ContactChannel (Prelude.Maybe ChannelType)
contactChannel_type :: Lens' ContactChannel (Maybe ChannelType)
contactChannel_type = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ContactChannel' {Maybe ChannelType
type' :: Maybe ChannelType
$sel:type':ContactChannel' :: ContactChannel -> Maybe ChannelType
type'} -> Maybe ChannelType
type') (\s :: ContactChannel
s@ContactChannel' {} Maybe ChannelType
a -> ContactChannel
s {$sel:type':ContactChannel' :: Maybe ChannelType
type' = Maybe ChannelType
a} :: ContactChannel)

-- | The Amazon Resource Name (ARN) of the contact channel.
contactChannel_contactChannelArn :: Lens.Lens' ContactChannel Prelude.Text
contactChannel_contactChannelArn :: Lens' ContactChannel Text
contactChannel_contactChannelArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ContactChannel' {Text
contactChannelArn :: Text
$sel:contactChannelArn:ContactChannel' :: ContactChannel -> Text
contactChannelArn} -> Text
contactChannelArn) (\s :: ContactChannel
s@ContactChannel' {} Text
a -> ContactChannel
s {$sel:contactChannelArn:ContactChannel' :: Text
contactChannelArn = Text
a} :: ContactChannel)

-- | The ARN of the contact that contains the contact channel.
contactChannel_contactArn :: Lens.Lens' ContactChannel Prelude.Text
contactChannel_contactArn :: Lens' ContactChannel Text
contactChannel_contactArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ContactChannel' {Text
contactArn :: Text
$sel:contactArn:ContactChannel' :: ContactChannel -> Text
contactArn} -> Text
contactArn) (\s :: ContactChannel
s@ContactChannel' {} Text
a -> ContactChannel
s {$sel:contactArn:ContactChannel' :: Text
contactArn = Text
a} :: ContactChannel)

-- | The name of the contact channel.
contactChannel_name :: Lens.Lens' ContactChannel Prelude.Text
contactChannel_name :: Lens' ContactChannel Text
contactChannel_name = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ContactChannel' {Text
name :: Text
$sel:name:ContactChannel' :: ContactChannel -> Text
name} -> Text
name) (\s :: ContactChannel
s@ContactChannel' {} Text
a -> ContactChannel
s {$sel:name:ContactChannel' :: Text
name = Text
a} :: ContactChannel)

-- | The details that Incident Manager uses when trying to engage the contact
-- channel.
contactChannel_deliveryAddress :: Lens.Lens' ContactChannel ContactChannelAddress
contactChannel_deliveryAddress :: Lens' ContactChannel ContactChannelAddress
contactChannel_deliveryAddress = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ContactChannel' {ContactChannelAddress
deliveryAddress :: ContactChannelAddress
$sel:deliveryAddress:ContactChannel' :: ContactChannel -> ContactChannelAddress
deliveryAddress} -> ContactChannelAddress
deliveryAddress) (\s :: ContactChannel
s@ContactChannel' {} ContactChannelAddress
a -> ContactChannel
s {$sel:deliveryAddress:ContactChannel' :: ContactChannelAddress
deliveryAddress = ContactChannelAddress
a} :: ContactChannel)

-- | A Boolean value describing if the contact channel has been activated or
-- not. If the contact channel isn\'t activated, Incident Manager can\'t
-- engage the contact through it.
contactChannel_activationStatus :: Lens.Lens' ContactChannel ActivationStatus
contactChannel_activationStatus :: Lens' ContactChannel ActivationStatus
contactChannel_activationStatus = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ContactChannel' {ActivationStatus
activationStatus :: ActivationStatus
$sel:activationStatus:ContactChannel' :: ContactChannel -> ActivationStatus
activationStatus} -> ActivationStatus
activationStatus) (\s :: ContactChannel
s@ContactChannel' {} ActivationStatus
a -> ContactChannel
s {$sel:activationStatus:ContactChannel' :: ActivationStatus
activationStatus = ActivationStatus
a} :: ContactChannel)

instance Data.FromJSON ContactChannel where
  parseJSON :: Value -> Parser ContactChannel
parseJSON =
    forall a. String -> (Object -> Parser a) -> Value -> Parser a
Data.withObject
      String
"ContactChannel"
      ( \Object
x ->
          Maybe ChannelType
-> Text
-> Text
-> Text
-> ContactChannelAddress
-> ActivationStatus
-> ContactChannel
ContactChannel'
            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
"Type")
            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
"ContactChannelArn")
            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
"ContactArn")
            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
"Name")
            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
"DeliveryAddress")
            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
"ActivationStatus")
      )

instance Prelude.Hashable ContactChannel where
  hashWithSalt :: Int -> ContactChannel -> Int
hashWithSalt Int
_salt ContactChannel' {Maybe ChannelType
Text
ActivationStatus
ContactChannelAddress
activationStatus :: ActivationStatus
deliveryAddress :: ContactChannelAddress
name :: Text
contactArn :: Text
contactChannelArn :: Text
type' :: Maybe ChannelType
$sel:activationStatus:ContactChannel' :: ContactChannel -> ActivationStatus
$sel:deliveryAddress:ContactChannel' :: ContactChannel -> ContactChannelAddress
$sel:name:ContactChannel' :: ContactChannel -> Text
$sel:contactArn:ContactChannel' :: ContactChannel -> Text
$sel:contactChannelArn:ContactChannel' :: ContactChannel -> Text
$sel:type':ContactChannel' :: ContactChannel -> Maybe ChannelType
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe ChannelType
type'
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
contactChannelArn
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
contactArn
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
name
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` ContactChannelAddress
deliveryAddress
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` ActivationStatus
activationStatus

instance Prelude.NFData ContactChannel where
  rnf :: ContactChannel -> ()
rnf ContactChannel' {Maybe ChannelType
Text
ActivationStatus
ContactChannelAddress
activationStatus :: ActivationStatus
deliveryAddress :: ContactChannelAddress
name :: Text
contactArn :: Text
contactChannelArn :: Text
type' :: Maybe ChannelType
$sel:activationStatus:ContactChannel' :: ContactChannel -> ActivationStatus
$sel:deliveryAddress:ContactChannel' :: ContactChannel -> ContactChannelAddress
$sel:name:ContactChannel' :: ContactChannel -> Text
$sel:contactArn:ContactChannel' :: ContactChannel -> Text
$sel:contactChannelArn:ContactChannel' :: ContactChannel -> Text
$sel:type':ContactChannel' :: ContactChannel -> Maybe ChannelType
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe ChannelType
type'
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
contactChannelArn
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
contactArn
      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 ContactChannelAddress
deliveryAddress
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf ActivationStatus
activationStatus