{-# 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.GetContactChannel
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- List details about a specific contact channel.
module Amazonka.SSMContacts.GetContactChannel
  ( -- * Creating a Request
    GetContactChannel (..),
    newGetContactChannel,

    -- * Request Lenses
    getContactChannel_contactChannelId,

    -- * Destructuring the Response
    GetContactChannelResponse (..),
    newGetContactChannelResponse,

    -- * Response Lenses
    getContactChannelResponse_activationStatus,
    getContactChannelResponse_httpStatus,
    getContactChannelResponse_contactArn,
    getContactChannelResponse_contactChannelArn,
    getContactChannelResponse_name,
    getContactChannelResponse_type,
    getContactChannelResponse_deliveryAddress,
  )
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:/ 'newGetContactChannel' smart constructor.
data GetContactChannel = GetContactChannel'
  { -- | The Amazon Resource Name (ARN) of the contact channel you want
    -- information about.
    GetContactChannel -> Text
contactChannelId :: Prelude.Text
  }
  deriving (GetContactChannel -> GetContactChannel -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetContactChannel -> GetContactChannel -> Bool
$c/= :: GetContactChannel -> GetContactChannel -> Bool
== :: GetContactChannel -> GetContactChannel -> Bool
$c== :: GetContactChannel -> GetContactChannel -> Bool
Prelude.Eq, ReadPrec [GetContactChannel]
ReadPrec GetContactChannel
Int -> ReadS GetContactChannel
ReadS [GetContactChannel]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GetContactChannel]
$creadListPrec :: ReadPrec [GetContactChannel]
readPrec :: ReadPrec GetContactChannel
$creadPrec :: ReadPrec GetContactChannel
readList :: ReadS [GetContactChannel]
$creadList :: ReadS [GetContactChannel]
readsPrec :: Int -> ReadS GetContactChannel
$creadsPrec :: Int -> ReadS GetContactChannel
Prelude.Read, Int -> GetContactChannel -> ShowS
[GetContactChannel] -> ShowS
GetContactChannel -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetContactChannel] -> ShowS
$cshowList :: [GetContactChannel] -> ShowS
show :: GetContactChannel -> String
$cshow :: GetContactChannel -> String
showsPrec :: Int -> GetContactChannel -> ShowS
$cshowsPrec :: Int -> GetContactChannel -> ShowS
Prelude.Show, forall x. Rep GetContactChannel x -> GetContactChannel
forall x. GetContactChannel -> Rep GetContactChannel x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep GetContactChannel x -> GetContactChannel
$cfrom :: forall x. GetContactChannel -> Rep GetContactChannel x
Prelude.Generic)

-- |
-- Create a value of 'GetContactChannel' 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:
--
-- 'contactChannelId', 'getContactChannel_contactChannelId' - The Amazon Resource Name (ARN) of the contact channel you want
-- information about.
newGetContactChannel ::
  -- | 'contactChannelId'
  Prelude.Text ->
  GetContactChannel
newGetContactChannel :: Text -> GetContactChannel
newGetContactChannel Text
pContactChannelId_ =
  GetContactChannel'
    { $sel:contactChannelId:GetContactChannel' :: Text
contactChannelId =
        Text
pContactChannelId_
    }

-- | The Amazon Resource Name (ARN) of the contact channel you want
-- information about.
getContactChannel_contactChannelId :: Lens.Lens' GetContactChannel Prelude.Text
getContactChannel_contactChannelId :: Lens' GetContactChannel Text
getContactChannel_contactChannelId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetContactChannel' {Text
contactChannelId :: Text
$sel:contactChannelId:GetContactChannel' :: GetContactChannel -> Text
contactChannelId} -> Text
contactChannelId) (\s :: GetContactChannel
s@GetContactChannel' {} Text
a -> GetContactChannel
s {$sel:contactChannelId:GetContactChannel' :: Text
contactChannelId = Text
a} :: GetContactChannel)

instance Core.AWSRequest GetContactChannel where
  type
    AWSResponse GetContactChannel =
      GetContactChannelResponse
  request :: (Service -> Service)
-> GetContactChannel -> Request GetContactChannel
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 GetContactChannel
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse GetContactChannel)))
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 ->
          Maybe ActivationStatus
-> Int
-> Text
-> Text
-> Text
-> ChannelType
-> ContactChannelAddress
-> GetContactChannelResponse
GetContactChannelResponse'
            forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"ActivationStatus")
            forall (f :: * -> *) a b. Applicative f => 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
"ContactArn")
            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")
            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
"Name")
            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
"Type")
            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
"DeliveryAddress")
      )

instance Prelude.Hashable GetContactChannel where
  hashWithSalt :: Int -> GetContactChannel -> Int
hashWithSalt Int
_salt GetContactChannel' {Text
contactChannelId :: Text
$sel:contactChannelId:GetContactChannel' :: GetContactChannel -> Text
..} =
    Int
_salt forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
contactChannelId

instance Prelude.NFData GetContactChannel where
  rnf :: GetContactChannel -> ()
rnf GetContactChannel' {Text
contactChannelId :: Text
$sel:contactChannelId:GetContactChannel' :: GetContactChannel -> Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Text
contactChannelId

instance Data.ToHeaders GetContactChannel where
  toHeaders :: GetContactChannel -> 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.GetContactChannel" ::
                          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 GetContactChannel where
  toJSON :: GetContactChannel -> Value
toJSON GetContactChannel' {Text
contactChannelId :: Text
$sel:contactChannelId:GetContactChannel' :: GetContactChannel -> Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ forall a. a -> Maybe a
Prelude.Just
              (Key
"ContactChannelId" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
contactChannelId)
          ]
      )

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

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

-- | /See:/ 'newGetContactChannelResponse' smart constructor.
data GetContactChannelResponse = GetContactChannelResponse'
  { -- | A Boolean value indicating if the contact channel has been activated or
    -- not.
    GetContactChannelResponse -> Maybe ActivationStatus
activationStatus :: Prelude.Maybe ActivationStatus,
    -- | The response's http status code.
    GetContactChannelResponse -> Int
httpStatus :: Prelude.Int,
    -- | The ARN of the contact that the channel belongs to.
    GetContactChannelResponse -> Text
contactArn :: Prelude.Text,
    -- | The ARN of the contact channel.
    GetContactChannelResponse -> Text
contactChannelArn :: Prelude.Text,
    -- | The name of the contact channel
    GetContactChannelResponse -> Text
name :: Prelude.Text,
    -- | The type of contact channel. The type is @SMS@, @VOICE@, or @EMAIL@.
    GetContactChannelResponse -> ChannelType
type' :: ChannelType,
    -- | The details that Incident Manager uses when trying to engage the contact
    -- channel.
    GetContactChannelResponse -> ContactChannelAddress
deliveryAddress :: ContactChannelAddress
  }
  deriving (GetContactChannelResponse -> GetContactChannelResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetContactChannelResponse -> GetContactChannelResponse -> Bool
$c/= :: GetContactChannelResponse -> GetContactChannelResponse -> Bool
== :: GetContactChannelResponse -> GetContactChannelResponse -> Bool
$c== :: GetContactChannelResponse -> GetContactChannelResponse -> Bool
Prelude.Eq, ReadPrec [GetContactChannelResponse]
ReadPrec GetContactChannelResponse
Int -> ReadS GetContactChannelResponse
ReadS [GetContactChannelResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GetContactChannelResponse]
$creadListPrec :: ReadPrec [GetContactChannelResponse]
readPrec :: ReadPrec GetContactChannelResponse
$creadPrec :: ReadPrec GetContactChannelResponse
readList :: ReadS [GetContactChannelResponse]
$creadList :: ReadS [GetContactChannelResponse]
readsPrec :: Int -> ReadS GetContactChannelResponse
$creadsPrec :: Int -> ReadS GetContactChannelResponse
Prelude.Read, Int -> GetContactChannelResponse -> ShowS
[GetContactChannelResponse] -> ShowS
GetContactChannelResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetContactChannelResponse] -> ShowS
$cshowList :: [GetContactChannelResponse] -> ShowS
show :: GetContactChannelResponse -> String
$cshow :: GetContactChannelResponse -> String
showsPrec :: Int -> GetContactChannelResponse -> ShowS
$cshowsPrec :: Int -> GetContactChannelResponse -> ShowS
Prelude.Show, forall x.
Rep GetContactChannelResponse x -> GetContactChannelResponse
forall x.
GetContactChannelResponse -> Rep GetContactChannelResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep GetContactChannelResponse x -> GetContactChannelResponse
$cfrom :: forall x.
GetContactChannelResponse -> Rep GetContactChannelResponse x
Prelude.Generic)

-- |
-- Create a value of 'GetContactChannelResponse' 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:
--
-- 'activationStatus', 'getContactChannelResponse_activationStatus' - A Boolean value indicating if the contact channel has been activated or
-- not.
--
-- 'httpStatus', 'getContactChannelResponse_httpStatus' - The response's http status code.
--
-- 'contactArn', 'getContactChannelResponse_contactArn' - The ARN of the contact that the channel belongs to.
--
-- 'contactChannelArn', 'getContactChannelResponse_contactChannelArn' - The ARN of the contact channel.
--
-- 'name', 'getContactChannelResponse_name' - The name of the contact channel
--
-- 'type'', 'getContactChannelResponse_type' - The type of contact channel. The type is @SMS@, @VOICE@, or @EMAIL@.
--
-- 'deliveryAddress', 'getContactChannelResponse_deliveryAddress' - The details that Incident Manager uses when trying to engage the contact
-- channel.
newGetContactChannelResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  -- | 'contactArn'
  Prelude.Text ->
  -- | 'contactChannelArn'
  Prelude.Text ->
  -- | 'name'
  Prelude.Text ->
  -- | 'type''
  ChannelType ->
  -- | 'deliveryAddress'
  ContactChannelAddress ->
  GetContactChannelResponse
newGetContactChannelResponse :: Int
-> Text
-> Text
-> Text
-> ChannelType
-> ContactChannelAddress
-> GetContactChannelResponse
newGetContactChannelResponse
  Int
pHttpStatus_
  Text
pContactArn_
  Text
pContactChannelArn_
  Text
pName_
  ChannelType
pType_
  ContactChannelAddress
pDeliveryAddress_ =
    GetContactChannelResponse'
      { $sel:activationStatus:GetContactChannelResponse' :: Maybe ActivationStatus
activationStatus =
          forall a. Maybe a
Prelude.Nothing,
        $sel:httpStatus:GetContactChannelResponse' :: Int
httpStatus = Int
pHttpStatus_,
        $sel:contactArn:GetContactChannelResponse' :: Text
contactArn = Text
pContactArn_,
        $sel:contactChannelArn:GetContactChannelResponse' :: Text
contactChannelArn = Text
pContactChannelArn_,
        $sel:name:GetContactChannelResponse' :: Text
name = Text
pName_,
        $sel:type':GetContactChannelResponse' :: ChannelType
type' = ChannelType
pType_,
        $sel:deliveryAddress:GetContactChannelResponse' :: ContactChannelAddress
deliveryAddress = ContactChannelAddress
pDeliveryAddress_
      }

-- | A Boolean value indicating if the contact channel has been activated or
-- not.
getContactChannelResponse_activationStatus :: Lens.Lens' GetContactChannelResponse (Prelude.Maybe ActivationStatus)
getContactChannelResponse_activationStatus :: Lens' GetContactChannelResponse (Maybe ActivationStatus)
getContactChannelResponse_activationStatus = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetContactChannelResponse' {Maybe ActivationStatus
activationStatus :: Maybe ActivationStatus
$sel:activationStatus:GetContactChannelResponse' :: GetContactChannelResponse -> Maybe ActivationStatus
activationStatus} -> Maybe ActivationStatus
activationStatus) (\s :: GetContactChannelResponse
s@GetContactChannelResponse' {} Maybe ActivationStatus
a -> GetContactChannelResponse
s {$sel:activationStatus:GetContactChannelResponse' :: Maybe ActivationStatus
activationStatus = Maybe ActivationStatus
a} :: GetContactChannelResponse)

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

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

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

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

-- | The type of contact channel. The type is @SMS@, @VOICE@, or @EMAIL@.
getContactChannelResponse_type :: Lens.Lens' GetContactChannelResponse ChannelType
getContactChannelResponse_type :: Lens' GetContactChannelResponse ChannelType
getContactChannelResponse_type = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetContactChannelResponse' {ChannelType
type' :: ChannelType
$sel:type':GetContactChannelResponse' :: GetContactChannelResponse -> ChannelType
type'} -> ChannelType
type') (\s :: GetContactChannelResponse
s@GetContactChannelResponse' {} ChannelType
a -> GetContactChannelResponse
s {$sel:type':GetContactChannelResponse' :: ChannelType
type' = ChannelType
a} :: GetContactChannelResponse)

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

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