{-# 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.SSMContacts.CreateContactChannel
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- A contact channel is the method that Incident Manager uses to engage
-- your contact.
module Amazonka.SSMContacts.CreateContactChannel
  ( -- * Creating a Request
    CreateContactChannel (..),
    newCreateContactChannel,

    -- * Request Lenses
    createContactChannel_deferActivation,
    createContactChannel_idempotencyToken,
    createContactChannel_contactId,
    createContactChannel_name,
    createContactChannel_type,
    createContactChannel_deliveryAddress,

    -- * Destructuring the Response
    CreateContactChannelResponse (..),
    newCreateContactChannelResponse,

    -- * Response Lenses
    createContactChannelResponse_httpStatus,
    createContactChannelResponse_contactChannelArn,
  )
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 qualified Amazonka.Request as Request
import qualified Amazonka.Response as Response
import Amazonka.SSMContacts.Types

-- | /See:/ 'newCreateContactChannel' smart constructor.
data CreateContactChannel = CreateContactChannel'
  { -- | If you want to activate the channel at a later time, you can choose to
    -- defer activation. Incident Manager can\'t engage your contact channel
    -- until it has been activated.
    CreateContactChannel -> Maybe Bool
deferActivation :: Prelude.Maybe Prelude.Bool,
    -- | A token ensuring that the operation is called only once with the
    -- specified details.
    CreateContactChannel -> Maybe Text
idempotencyToken :: Prelude.Maybe Prelude.Text,
    -- | The Amazon Resource Name (ARN) of the contact you are adding the contact
    -- channel to.
    CreateContactChannel -> Text
contactId :: Prelude.Text,
    -- | The name of the contact channel.
    CreateContactChannel -> Text
name :: Prelude.Text,
    -- | Incident Manager supports three types of contact channels:
    --
    -- -   @SMS@
    --
    -- -   @VOICE@
    --
    -- -   @EMAIL@
    CreateContactChannel -> ChannelType
type' :: ChannelType,
    -- | The details that Incident Manager uses when trying to engage the contact
    -- channel. The format is dependent on the type of the contact channel. The
    -- following are the expected formats:
    --
    -- -   SMS - \'+\' followed by the country code and phone number
    --
    -- -   VOICE - \'+\' followed by the country code and phone number
    --
    -- -   EMAIL - any standard email format
    CreateContactChannel -> ContactChannelAddress
deliveryAddress :: ContactChannelAddress
  }
  deriving (CreateContactChannel -> CreateContactChannel -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateContactChannel -> CreateContactChannel -> Bool
$c/= :: CreateContactChannel -> CreateContactChannel -> Bool
== :: CreateContactChannel -> CreateContactChannel -> Bool
$c== :: CreateContactChannel -> CreateContactChannel -> Bool
Prelude.Eq, ReadPrec [CreateContactChannel]
ReadPrec CreateContactChannel
Int -> ReadS CreateContactChannel
ReadS [CreateContactChannel]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CreateContactChannel]
$creadListPrec :: ReadPrec [CreateContactChannel]
readPrec :: ReadPrec CreateContactChannel
$creadPrec :: ReadPrec CreateContactChannel
readList :: ReadS [CreateContactChannel]
$creadList :: ReadS [CreateContactChannel]
readsPrec :: Int -> ReadS CreateContactChannel
$creadsPrec :: Int -> ReadS CreateContactChannel
Prelude.Read, Int -> CreateContactChannel -> ShowS
[CreateContactChannel] -> ShowS
CreateContactChannel -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateContactChannel] -> ShowS
$cshowList :: [CreateContactChannel] -> ShowS
show :: CreateContactChannel -> String
$cshow :: CreateContactChannel -> String
showsPrec :: Int -> CreateContactChannel -> ShowS
$cshowsPrec :: Int -> CreateContactChannel -> ShowS
Prelude.Show, forall x. Rep CreateContactChannel x -> CreateContactChannel
forall x. CreateContactChannel -> Rep CreateContactChannel x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CreateContactChannel x -> CreateContactChannel
$cfrom :: forall x. CreateContactChannel -> Rep CreateContactChannel x
Prelude.Generic)

-- |
-- Create a value of 'CreateContactChannel' 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:
--
-- 'deferActivation', 'createContactChannel_deferActivation' - If you want to activate the channel at a later time, you can choose to
-- defer activation. Incident Manager can\'t engage your contact channel
-- until it has been activated.
--
-- 'idempotencyToken', 'createContactChannel_idempotencyToken' - A token ensuring that the operation is called only once with the
-- specified details.
--
-- 'contactId', 'createContactChannel_contactId' - The Amazon Resource Name (ARN) of the contact you are adding the contact
-- channel to.
--
-- 'name', 'createContactChannel_name' - The name of the contact channel.
--
-- 'type'', 'createContactChannel_type' - Incident Manager supports three types of contact channels:
--
-- -   @SMS@
--
-- -   @VOICE@
--
-- -   @EMAIL@
--
-- 'deliveryAddress', 'createContactChannel_deliveryAddress' - The details that Incident Manager uses when trying to engage the contact
-- channel. The format is dependent on the type of the contact channel. The
-- following are the expected formats:
--
-- -   SMS - \'+\' followed by the country code and phone number
--
-- -   VOICE - \'+\' followed by the country code and phone number
--
-- -   EMAIL - any standard email format
newCreateContactChannel ::
  -- | 'contactId'
  Prelude.Text ->
  -- | 'name'
  Prelude.Text ->
  -- | 'type''
  ChannelType ->
  -- | 'deliveryAddress'
  ContactChannelAddress ->
  CreateContactChannel
newCreateContactChannel :: Text
-> Text
-> ChannelType
-> ContactChannelAddress
-> CreateContactChannel
newCreateContactChannel
  Text
pContactId_
  Text
pName_
  ChannelType
pType_
  ContactChannelAddress
pDeliveryAddress_ =
    CreateContactChannel'
      { $sel:deferActivation:CreateContactChannel' :: Maybe Bool
deferActivation =
          forall a. Maybe a
Prelude.Nothing,
        $sel:idempotencyToken:CreateContactChannel' :: Maybe Text
idempotencyToken = forall a. Maybe a
Prelude.Nothing,
        $sel:contactId:CreateContactChannel' :: Text
contactId = Text
pContactId_,
        $sel:name:CreateContactChannel' :: Text
name = Text
pName_,
        $sel:type':CreateContactChannel' :: ChannelType
type' = ChannelType
pType_,
        $sel:deliveryAddress:CreateContactChannel' :: ContactChannelAddress
deliveryAddress = ContactChannelAddress
pDeliveryAddress_
      }

-- | If you want to activate the channel at a later time, you can choose to
-- defer activation. Incident Manager can\'t engage your contact channel
-- until it has been activated.
createContactChannel_deferActivation :: Lens.Lens' CreateContactChannel (Prelude.Maybe Prelude.Bool)
createContactChannel_deferActivation :: Lens' CreateContactChannel (Maybe Bool)
createContactChannel_deferActivation = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateContactChannel' {Maybe Bool
deferActivation :: Maybe Bool
$sel:deferActivation:CreateContactChannel' :: CreateContactChannel -> Maybe Bool
deferActivation} -> Maybe Bool
deferActivation) (\s :: CreateContactChannel
s@CreateContactChannel' {} Maybe Bool
a -> CreateContactChannel
s {$sel:deferActivation:CreateContactChannel' :: Maybe Bool
deferActivation = Maybe Bool
a} :: CreateContactChannel)

-- | A token ensuring that the operation is called only once with the
-- specified details.
createContactChannel_idempotencyToken :: Lens.Lens' CreateContactChannel (Prelude.Maybe Prelude.Text)
createContactChannel_idempotencyToken :: Lens' CreateContactChannel (Maybe Text)
createContactChannel_idempotencyToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateContactChannel' {Maybe Text
idempotencyToken :: Maybe Text
$sel:idempotencyToken:CreateContactChannel' :: CreateContactChannel -> Maybe Text
idempotencyToken} -> Maybe Text
idempotencyToken) (\s :: CreateContactChannel
s@CreateContactChannel' {} Maybe Text
a -> CreateContactChannel
s {$sel:idempotencyToken:CreateContactChannel' :: Maybe Text
idempotencyToken = Maybe Text
a} :: CreateContactChannel)

-- | The Amazon Resource Name (ARN) of the contact you are adding the contact
-- channel to.
createContactChannel_contactId :: Lens.Lens' CreateContactChannel Prelude.Text
createContactChannel_contactId :: Lens' CreateContactChannel Text
createContactChannel_contactId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateContactChannel' {Text
contactId :: Text
$sel:contactId:CreateContactChannel' :: CreateContactChannel -> Text
contactId} -> Text
contactId) (\s :: CreateContactChannel
s@CreateContactChannel' {} Text
a -> CreateContactChannel
s {$sel:contactId:CreateContactChannel' :: Text
contactId = Text
a} :: CreateContactChannel)

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

-- | Incident Manager supports three types of contact channels:
--
-- -   @SMS@
--
-- -   @VOICE@
--
-- -   @EMAIL@
createContactChannel_type :: Lens.Lens' CreateContactChannel ChannelType
createContactChannel_type :: Lens' CreateContactChannel ChannelType
createContactChannel_type = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateContactChannel' {ChannelType
type' :: ChannelType
$sel:type':CreateContactChannel' :: CreateContactChannel -> ChannelType
type'} -> ChannelType
type') (\s :: CreateContactChannel
s@CreateContactChannel' {} ChannelType
a -> CreateContactChannel
s {$sel:type':CreateContactChannel' :: ChannelType
type' = ChannelType
a} :: CreateContactChannel)

-- | The details that Incident Manager uses when trying to engage the contact
-- channel. The format is dependent on the type of the contact channel. The
-- following are the expected formats:
--
-- -   SMS - \'+\' followed by the country code and phone number
--
-- -   VOICE - \'+\' followed by the country code and phone number
--
-- -   EMAIL - any standard email format
createContactChannel_deliveryAddress :: Lens.Lens' CreateContactChannel ContactChannelAddress
createContactChannel_deliveryAddress :: Lens' CreateContactChannel ContactChannelAddress
createContactChannel_deliveryAddress = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateContactChannel' {ContactChannelAddress
deliveryAddress :: ContactChannelAddress
$sel:deliveryAddress:CreateContactChannel' :: CreateContactChannel -> ContactChannelAddress
deliveryAddress} -> ContactChannelAddress
deliveryAddress) (\s :: CreateContactChannel
s@CreateContactChannel' {} ContactChannelAddress
a -> CreateContactChannel
s {$sel:deliveryAddress:CreateContactChannel' :: ContactChannelAddress
deliveryAddress = ContactChannelAddress
a} :: CreateContactChannel)

instance Core.AWSRequest CreateContactChannel where
  type
    AWSResponse CreateContactChannel =
      CreateContactChannelResponse
  request :: (Service -> Service)
-> CreateContactChannel -> Request CreateContactChannel
request Service -> Service
overrides =
    forall a. (ToRequest a, ToJSON a) => Service -> a -> Request a
Request.postJSON (Service -> Service
overrides Service
defaultService)
  response :: forall (m :: * -> *).
MonadResource m =>
(ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy CreateContactChannel
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse CreateContactChannel)))
response =
    forall (m :: * -> *) a.
MonadResource m =>
(Int -> ResponseHeaders -> Object -> Either String (AWSResponse a))
-> (ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy a
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse a)))
Response.receiveJSON
      ( \Int
s ResponseHeaders
h Object
x ->
          Int -> Text -> CreateContactChannelResponse
CreateContactChannelResponse'
            forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> (forall (f :: * -> *) a. Applicative f => a -> f a
Prelude.pure (forall a. Enum a => a -> Int
Prelude.fromEnum Int
s))
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String a
Data..:> Key
"ContactChannelArn")
      )

instance Prelude.Hashable CreateContactChannel where
  hashWithSalt :: Int -> CreateContactChannel -> Int
hashWithSalt Int
_salt CreateContactChannel' {Maybe Bool
Maybe Text
Text
ChannelType
ContactChannelAddress
deliveryAddress :: ContactChannelAddress
type' :: ChannelType
name :: Text
contactId :: Text
idempotencyToken :: Maybe Text
deferActivation :: Maybe Bool
$sel:deliveryAddress:CreateContactChannel' :: CreateContactChannel -> ContactChannelAddress
$sel:type':CreateContactChannel' :: CreateContactChannel -> ChannelType
$sel:name:CreateContactChannel' :: CreateContactChannel -> Text
$sel:contactId:CreateContactChannel' :: CreateContactChannel -> Text
$sel:idempotencyToken:CreateContactChannel' :: CreateContactChannel -> Maybe Text
$sel:deferActivation:CreateContactChannel' :: CreateContactChannel -> Maybe Bool
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Bool
deferActivation
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
idempotencyToken
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
contactId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
name
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` ChannelType
type'
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` ContactChannelAddress
deliveryAddress

instance Prelude.NFData CreateContactChannel where
  rnf :: CreateContactChannel -> ()
rnf CreateContactChannel' {Maybe Bool
Maybe Text
Text
ChannelType
ContactChannelAddress
deliveryAddress :: ContactChannelAddress
type' :: ChannelType
name :: Text
contactId :: Text
idempotencyToken :: Maybe Text
deferActivation :: Maybe Bool
$sel:deliveryAddress:CreateContactChannel' :: CreateContactChannel -> ContactChannelAddress
$sel:type':CreateContactChannel' :: CreateContactChannel -> ChannelType
$sel:name:CreateContactChannel' :: CreateContactChannel -> Text
$sel:contactId:CreateContactChannel' :: CreateContactChannel -> Text
$sel:idempotencyToken:CreateContactChannel' :: CreateContactChannel -> Maybe Text
$sel:deferActivation:CreateContactChannel' :: CreateContactChannel -> Maybe Bool
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Bool
deferActivation
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
idempotencyToken
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
contactId
      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 ChannelType
type'
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf ContactChannelAddress
deliveryAddress

instance Data.ToHeaders CreateContactChannel where
  toHeaders :: CreateContactChannel -> ResponseHeaders
toHeaders =
    forall a b. a -> b -> a
Prelude.const
      ( forall a. Monoid a => [a] -> a
Prelude.mconcat
          [ HeaderName
"X-Amz-Target"
              forall a. ToHeader a => HeaderName -> a -> ResponseHeaders
Data.=# ( ByteString
"SSMContacts.CreateContactChannel" ::
                          Prelude.ByteString
                      ),
            HeaderName
"Content-Type"
              forall a. ToHeader a => HeaderName -> a -> ResponseHeaders
Data.=# ( ByteString
"application/x-amz-json-1.1" ::
                          Prelude.ByteString
                      )
          ]
      )

instance Data.ToJSON CreateContactChannel where
  toJSON :: CreateContactChannel -> Value
toJSON CreateContactChannel' {Maybe Bool
Maybe Text
Text
ChannelType
ContactChannelAddress
deliveryAddress :: ContactChannelAddress
type' :: ChannelType
name :: Text
contactId :: Text
idempotencyToken :: Maybe Text
deferActivation :: Maybe Bool
$sel:deliveryAddress:CreateContactChannel' :: CreateContactChannel -> ContactChannelAddress
$sel:type':CreateContactChannel' :: CreateContactChannel -> ChannelType
$sel:name:CreateContactChannel' :: CreateContactChannel -> Text
$sel:contactId:CreateContactChannel' :: CreateContactChannel -> Text
$sel:idempotencyToken:CreateContactChannel' :: CreateContactChannel -> Maybe Text
$sel:deferActivation:CreateContactChannel' :: CreateContactChannel -> Maybe Bool
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"DeferActivation" 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 Bool
deferActivation,
            (Key
"IdempotencyToken" 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 Text
idempotencyToken,
            forall a. a -> Maybe a
Prelude.Just (Key
"ContactId" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
contactId),
            forall a. a -> Maybe a
Prelude.Just (Key
"Name" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
name),
            forall a. a -> Maybe a
Prelude.Just (Key
"Type" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= ChannelType
type'),
            forall a. a -> Maybe a
Prelude.Just
              (Key
"DeliveryAddress" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= ContactChannelAddress
deliveryAddress)
          ]
      )

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

instance Data.ToQuery CreateContactChannel where
  toQuery :: CreateContactChannel -> QueryString
toQuery = forall a b. a -> b -> a
Prelude.const forall a. Monoid a => a
Prelude.mempty

-- | /See:/ 'newCreateContactChannelResponse' smart constructor.
data CreateContactChannelResponse = CreateContactChannelResponse'
  { -- | The response's http status code.
    CreateContactChannelResponse -> Int
httpStatus :: Prelude.Int,
    -- | The Amazon Resource Name (ARN) of the contact channel.
    CreateContactChannelResponse -> Text
contactChannelArn :: Prelude.Text
  }
  deriving (CreateContactChannelResponse
-> CreateContactChannelResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateContactChannelResponse
-> CreateContactChannelResponse -> Bool
$c/= :: CreateContactChannelResponse
-> CreateContactChannelResponse -> Bool
== :: CreateContactChannelResponse
-> CreateContactChannelResponse -> Bool
$c== :: CreateContactChannelResponse
-> CreateContactChannelResponse -> Bool
Prelude.Eq, ReadPrec [CreateContactChannelResponse]
ReadPrec CreateContactChannelResponse
Int -> ReadS CreateContactChannelResponse
ReadS [CreateContactChannelResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CreateContactChannelResponse]
$creadListPrec :: ReadPrec [CreateContactChannelResponse]
readPrec :: ReadPrec CreateContactChannelResponse
$creadPrec :: ReadPrec CreateContactChannelResponse
readList :: ReadS [CreateContactChannelResponse]
$creadList :: ReadS [CreateContactChannelResponse]
readsPrec :: Int -> ReadS CreateContactChannelResponse
$creadsPrec :: Int -> ReadS CreateContactChannelResponse
Prelude.Read, Int -> CreateContactChannelResponse -> ShowS
[CreateContactChannelResponse] -> ShowS
CreateContactChannelResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateContactChannelResponse] -> ShowS
$cshowList :: [CreateContactChannelResponse] -> ShowS
show :: CreateContactChannelResponse -> String
$cshow :: CreateContactChannelResponse -> String
showsPrec :: Int -> CreateContactChannelResponse -> ShowS
$cshowsPrec :: Int -> CreateContactChannelResponse -> ShowS
Prelude.Show, forall x.
Rep CreateContactChannelResponse x -> CreateContactChannelResponse
forall x.
CreateContactChannelResponse -> Rep CreateContactChannelResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep CreateContactChannelResponse x -> CreateContactChannelResponse
$cfrom :: forall x.
CreateContactChannelResponse -> Rep CreateContactChannelResponse x
Prelude.Generic)

-- |
-- Create a value of 'CreateContactChannelResponse' 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:
--
-- 'httpStatus', 'createContactChannelResponse_httpStatus' - The response's http status code.
--
-- 'contactChannelArn', 'createContactChannelResponse_contactChannelArn' - The Amazon Resource Name (ARN) of the contact channel.
newCreateContactChannelResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  -- | 'contactChannelArn'
  Prelude.Text ->
  CreateContactChannelResponse
newCreateContactChannelResponse :: Int -> Text -> CreateContactChannelResponse
newCreateContactChannelResponse
  Int
pHttpStatus_
  Text
pContactChannelArn_ =
    CreateContactChannelResponse'
      { $sel:httpStatus:CreateContactChannelResponse' :: Int
httpStatus =
          Int
pHttpStatus_,
        $sel:contactChannelArn:CreateContactChannelResponse' :: Text
contactChannelArn = Text
pContactChannelArn_
      }

-- | The response's http status code.
createContactChannelResponse_httpStatus :: Lens.Lens' CreateContactChannelResponse Prelude.Int
createContactChannelResponse_httpStatus :: Lens' CreateContactChannelResponse Int
createContactChannelResponse_httpStatus = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateContactChannelResponse' {Int
httpStatus :: Int
$sel:httpStatus:CreateContactChannelResponse' :: CreateContactChannelResponse -> Int
httpStatus} -> Int
httpStatus) (\s :: CreateContactChannelResponse
s@CreateContactChannelResponse' {} Int
a -> CreateContactChannelResponse
s {$sel:httpStatus:CreateContactChannelResponse' :: Int
httpStatus = Int
a} :: CreateContactChannelResponse)

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

instance Prelude.NFData CreateContactChannelResponse where
  rnf :: CreateContactChannelResponse -> ()
rnf CreateContactChannelResponse' {Int
Text
contactChannelArn :: Text
httpStatus :: Int
$sel:contactChannelArn:CreateContactChannelResponse' :: CreateContactChannelResponse -> Text
$sel:httpStatus:CreateContactChannelResponse' :: CreateContactChannelResponse -> Int
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
contactChannelArn