{-# 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.Support.AddCommunicationToCase
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Adds additional customer communication to an Amazon Web Services Support
-- case. Use the @caseId@ parameter to identify the case to which to add
-- communication. You can list a set of email addresses to copy on the
-- communication by using the @ccEmailAddresses@ parameter. The
-- @communicationBody@ value contains the text of the communication.
--
-- -   You must have a Business, Enterprise On-Ramp, or Enterprise Support
--     plan to use the Amazon Web Services Support API.
--
-- -   If you call the Amazon Web Services Support API from an account that
--     doesn\'t have a Business, Enterprise On-Ramp, or Enterprise Support
--     plan, the @SubscriptionRequiredException@ error message appears. For
--     information about changing your support plan, see
--     <http://aws.amazon.com/premiumsupport/ Amazon Web Services Support>.
module Amazonka.Support.AddCommunicationToCase
  ( -- * Creating a Request
    AddCommunicationToCase (..),
    newAddCommunicationToCase,

    -- * Request Lenses
    addCommunicationToCase_attachmentSetId,
    addCommunicationToCase_caseId,
    addCommunicationToCase_ccEmailAddresses,
    addCommunicationToCase_communicationBody,

    -- * Destructuring the Response
    AddCommunicationToCaseResponse (..),
    newAddCommunicationToCaseResponse,

    -- * Response Lenses
    addCommunicationToCaseResponse_result,
    addCommunicationToCaseResponse_httpStatus,
  )
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.Support.Types

-- | /See:/ 'newAddCommunicationToCase' smart constructor.
data AddCommunicationToCase = AddCommunicationToCase'
  { -- | The ID of a set of one or more attachments for the communication to add
    -- to the case. Create the set by calling AddAttachmentsToSet
    AddCommunicationToCase -> Maybe Text
attachmentSetId :: Prelude.Maybe Prelude.Text,
    -- | The support case ID requested or returned in the call. The case ID is an
    -- alphanumeric string formatted as shown in this example:
    -- case-/12345678910-2013-c4c1d2bf33c5cf47/
    AddCommunicationToCase -> Maybe Text
caseId :: Prelude.Maybe Prelude.Text,
    -- | The email addresses in the CC line of an email to be added to the
    -- support case.
    AddCommunicationToCase -> Maybe [Text]
ccEmailAddresses :: Prelude.Maybe [Prelude.Text],
    -- | The body of an email communication to add to the support case.
    AddCommunicationToCase -> Text
communicationBody :: Prelude.Text
  }
  deriving (AddCommunicationToCase -> AddCommunicationToCase -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AddCommunicationToCase -> AddCommunicationToCase -> Bool
$c/= :: AddCommunicationToCase -> AddCommunicationToCase -> Bool
== :: AddCommunicationToCase -> AddCommunicationToCase -> Bool
$c== :: AddCommunicationToCase -> AddCommunicationToCase -> Bool
Prelude.Eq, ReadPrec [AddCommunicationToCase]
ReadPrec AddCommunicationToCase
Int -> ReadS AddCommunicationToCase
ReadS [AddCommunicationToCase]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [AddCommunicationToCase]
$creadListPrec :: ReadPrec [AddCommunicationToCase]
readPrec :: ReadPrec AddCommunicationToCase
$creadPrec :: ReadPrec AddCommunicationToCase
readList :: ReadS [AddCommunicationToCase]
$creadList :: ReadS [AddCommunicationToCase]
readsPrec :: Int -> ReadS AddCommunicationToCase
$creadsPrec :: Int -> ReadS AddCommunicationToCase
Prelude.Read, Int -> AddCommunicationToCase -> ShowS
[AddCommunicationToCase] -> ShowS
AddCommunicationToCase -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AddCommunicationToCase] -> ShowS
$cshowList :: [AddCommunicationToCase] -> ShowS
show :: AddCommunicationToCase -> String
$cshow :: AddCommunicationToCase -> String
showsPrec :: Int -> AddCommunicationToCase -> ShowS
$cshowsPrec :: Int -> AddCommunicationToCase -> ShowS
Prelude.Show, forall x. Rep AddCommunicationToCase x -> AddCommunicationToCase
forall x. AddCommunicationToCase -> Rep AddCommunicationToCase x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep AddCommunicationToCase x -> AddCommunicationToCase
$cfrom :: forall x. AddCommunicationToCase -> Rep AddCommunicationToCase x
Prelude.Generic)

-- |
-- Create a value of 'AddCommunicationToCase' 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:
--
-- 'attachmentSetId', 'addCommunicationToCase_attachmentSetId' - The ID of a set of one or more attachments for the communication to add
-- to the case. Create the set by calling AddAttachmentsToSet
--
-- 'caseId', 'addCommunicationToCase_caseId' - The support case ID requested or returned in the call. The case ID is an
-- alphanumeric string formatted as shown in this example:
-- case-/12345678910-2013-c4c1d2bf33c5cf47/
--
-- 'ccEmailAddresses', 'addCommunicationToCase_ccEmailAddresses' - The email addresses in the CC line of an email to be added to the
-- support case.
--
-- 'communicationBody', 'addCommunicationToCase_communicationBody' - The body of an email communication to add to the support case.
newAddCommunicationToCase ::
  -- | 'communicationBody'
  Prelude.Text ->
  AddCommunicationToCase
newAddCommunicationToCase :: Text -> AddCommunicationToCase
newAddCommunicationToCase Text
pCommunicationBody_ =
  AddCommunicationToCase'
    { $sel:attachmentSetId:AddCommunicationToCase' :: Maybe Text
attachmentSetId =
        forall a. Maybe a
Prelude.Nothing,
      $sel:caseId:AddCommunicationToCase' :: Maybe Text
caseId = forall a. Maybe a
Prelude.Nothing,
      $sel:ccEmailAddresses:AddCommunicationToCase' :: Maybe [Text]
ccEmailAddresses = forall a. Maybe a
Prelude.Nothing,
      $sel:communicationBody:AddCommunicationToCase' :: Text
communicationBody = Text
pCommunicationBody_
    }

-- | The ID of a set of one or more attachments for the communication to add
-- to the case. Create the set by calling AddAttachmentsToSet
addCommunicationToCase_attachmentSetId :: Lens.Lens' AddCommunicationToCase (Prelude.Maybe Prelude.Text)
addCommunicationToCase_attachmentSetId :: Lens' AddCommunicationToCase (Maybe Text)
addCommunicationToCase_attachmentSetId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\AddCommunicationToCase' {Maybe Text
attachmentSetId :: Maybe Text
$sel:attachmentSetId:AddCommunicationToCase' :: AddCommunicationToCase -> Maybe Text
attachmentSetId} -> Maybe Text
attachmentSetId) (\s :: AddCommunicationToCase
s@AddCommunicationToCase' {} Maybe Text
a -> AddCommunicationToCase
s {$sel:attachmentSetId:AddCommunicationToCase' :: Maybe Text
attachmentSetId = Maybe Text
a} :: AddCommunicationToCase)

-- | The support case ID requested or returned in the call. The case ID is an
-- alphanumeric string formatted as shown in this example:
-- case-/12345678910-2013-c4c1d2bf33c5cf47/
addCommunicationToCase_caseId :: Lens.Lens' AddCommunicationToCase (Prelude.Maybe Prelude.Text)
addCommunicationToCase_caseId :: Lens' AddCommunicationToCase (Maybe Text)
addCommunicationToCase_caseId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\AddCommunicationToCase' {Maybe Text
caseId :: Maybe Text
$sel:caseId:AddCommunicationToCase' :: AddCommunicationToCase -> Maybe Text
caseId} -> Maybe Text
caseId) (\s :: AddCommunicationToCase
s@AddCommunicationToCase' {} Maybe Text
a -> AddCommunicationToCase
s {$sel:caseId:AddCommunicationToCase' :: Maybe Text
caseId = Maybe Text
a} :: AddCommunicationToCase)

-- | The email addresses in the CC line of an email to be added to the
-- support case.
addCommunicationToCase_ccEmailAddresses :: Lens.Lens' AddCommunicationToCase (Prelude.Maybe [Prelude.Text])
addCommunicationToCase_ccEmailAddresses :: Lens' AddCommunicationToCase (Maybe [Text])
addCommunicationToCase_ccEmailAddresses = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\AddCommunicationToCase' {Maybe [Text]
ccEmailAddresses :: Maybe [Text]
$sel:ccEmailAddresses:AddCommunicationToCase' :: AddCommunicationToCase -> Maybe [Text]
ccEmailAddresses} -> Maybe [Text]
ccEmailAddresses) (\s :: AddCommunicationToCase
s@AddCommunicationToCase' {} Maybe [Text]
a -> AddCommunicationToCase
s {$sel:ccEmailAddresses:AddCommunicationToCase' :: Maybe [Text]
ccEmailAddresses = Maybe [Text]
a} :: AddCommunicationToCase) 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

-- | The body of an email communication to add to the support case.
addCommunicationToCase_communicationBody :: Lens.Lens' AddCommunicationToCase Prelude.Text
addCommunicationToCase_communicationBody :: Lens' AddCommunicationToCase Text
addCommunicationToCase_communicationBody = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\AddCommunicationToCase' {Text
communicationBody :: Text
$sel:communicationBody:AddCommunicationToCase' :: AddCommunicationToCase -> Text
communicationBody} -> Text
communicationBody) (\s :: AddCommunicationToCase
s@AddCommunicationToCase' {} Text
a -> AddCommunicationToCase
s {$sel:communicationBody:AddCommunicationToCase' :: Text
communicationBody = Text
a} :: AddCommunicationToCase)

instance Core.AWSRequest AddCommunicationToCase where
  type
    AWSResponse AddCommunicationToCase =
      AddCommunicationToCaseResponse
  request :: (Service -> Service)
-> AddCommunicationToCase -> Request AddCommunicationToCase
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 AddCommunicationToCase
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse AddCommunicationToCase)))
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 Bool -> Int -> AddCommunicationToCaseResponse
AddCommunicationToCaseResponse'
            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
"result")
            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))
      )

instance Prelude.Hashable AddCommunicationToCase where
  hashWithSalt :: Int -> AddCommunicationToCase -> Int
hashWithSalt Int
_salt AddCommunicationToCase' {Maybe [Text]
Maybe Text
Text
communicationBody :: Text
ccEmailAddresses :: Maybe [Text]
caseId :: Maybe Text
attachmentSetId :: Maybe Text
$sel:communicationBody:AddCommunicationToCase' :: AddCommunicationToCase -> Text
$sel:ccEmailAddresses:AddCommunicationToCase' :: AddCommunicationToCase -> Maybe [Text]
$sel:caseId:AddCommunicationToCase' :: AddCommunicationToCase -> Maybe Text
$sel:attachmentSetId:AddCommunicationToCase' :: AddCommunicationToCase -> Maybe Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
attachmentSetId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
caseId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [Text]
ccEmailAddresses
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
communicationBody

instance Prelude.NFData AddCommunicationToCase where
  rnf :: AddCommunicationToCase -> ()
rnf AddCommunicationToCase' {Maybe [Text]
Maybe Text
Text
communicationBody :: Text
ccEmailAddresses :: Maybe [Text]
caseId :: Maybe Text
attachmentSetId :: Maybe Text
$sel:communicationBody:AddCommunicationToCase' :: AddCommunicationToCase -> Text
$sel:ccEmailAddresses:AddCommunicationToCase' :: AddCommunicationToCase -> Maybe [Text]
$sel:caseId:AddCommunicationToCase' :: AddCommunicationToCase -> Maybe Text
$sel:attachmentSetId:AddCommunicationToCase' :: AddCommunicationToCase -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
attachmentSetId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
caseId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [Text]
ccEmailAddresses
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
communicationBody

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

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

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

-- | The result of the AddCommunicationToCase operation.
--
-- /See:/ 'newAddCommunicationToCaseResponse' smart constructor.
data AddCommunicationToCaseResponse = AddCommunicationToCaseResponse'
  { -- | True if AddCommunicationToCase succeeds. Otherwise, returns an error.
    AddCommunicationToCaseResponse -> Maybe Bool
result :: Prelude.Maybe Prelude.Bool,
    -- | The response's http status code.
    AddCommunicationToCaseResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (AddCommunicationToCaseResponse
-> AddCommunicationToCaseResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AddCommunicationToCaseResponse
-> AddCommunicationToCaseResponse -> Bool
$c/= :: AddCommunicationToCaseResponse
-> AddCommunicationToCaseResponse -> Bool
== :: AddCommunicationToCaseResponse
-> AddCommunicationToCaseResponse -> Bool
$c== :: AddCommunicationToCaseResponse
-> AddCommunicationToCaseResponse -> Bool
Prelude.Eq, ReadPrec [AddCommunicationToCaseResponse]
ReadPrec AddCommunicationToCaseResponse
Int -> ReadS AddCommunicationToCaseResponse
ReadS [AddCommunicationToCaseResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [AddCommunicationToCaseResponse]
$creadListPrec :: ReadPrec [AddCommunicationToCaseResponse]
readPrec :: ReadPrec AddCommunicationToCaseResponse
$creadPrec :: ReadPrec AddCommunicationToCaseResponse
readList :: ReadS [AddCommunicationToCaseResponse]
$creadList :: ReadS [AddCommunicationToCaseResponse]
readsPrec :: Int -> ReadS AddCommunicationToCaseResponse
$creadsPrec :: Int -> ReadS AddCommunicationToCaseResponse
Prelude.Read, Int -> AddCommunicationToCaseResponse -> ShowS
[AddCommunicationToCaseResponse] -> ShowS
AddCommunicationToCaseResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AddCommunicationToCaseResponse] -> ShowS
$cshowList :: [AddCommunicationToCaseResponse] -> ShowS
show :: AddCommunicationToCaseResponse -> String
$cshow :: AddCommunicationToCaseResponse -> String
showsPrec :: Int -> AddCommunicationToCaseResponse -> ShowS
$cshowsPrec :: Int -> AddCommunicationToCaseResponse -> ShowS
Prelude.Show, forall x.
Rep AddCommunicationToCaseResponse x
-> AddCommunicationToCaseResponse
forall x.
AddCommunicationToCaseResponse
-> Rep AddCommunicationToCaseResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep AddCommunicationToCaseResponse x
-> AddCommunicationToCaseResponse
$cfrom :: forall x.
AddCommunicationToCaseResponse
-> Rep AddCommunicationToCaseResponse x
Prelude.Generic)

-- |
-- Create a value of 'AddCommunicationToCaseResponse' 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:
--
-- 'result', 'addCommunicationToCaseResponse_result' - True if AddCommunicationToCase succeeds. Otherwise, returns an error.
--
-- 'httpStatus', 'addCommunicationToCaseResponse_httpStatus' - The response's http status code.
newAddCommunicationToCaseResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  AddCommunicationToCaseResponse
newAddCommunicationToCaseResponse :: Int -> AddCommunicationToCaseResponse
newAddCommunicationToCaseResponse Int
pHttpStatus_ =
  AddCommunicationToCaseResponse'
    { $sel:result:AddCommunicationToCaseResponse' :: Maybe Bool
result =
        forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:AddCommunicationToCaseResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | True if AddCommunicationToCase succeeds. Otherwise, returns an error.
addCommunicationToCaseResponse_result :: Lens.Lens' AddCommunicationToCaseResponse (Prelude.Maybe Prelude.Bool)
addCommunicationToCaseResponse_result :: Lens' AddCommunicationToCaseResponse (Maybe Bool)
addCommunicationToCaseResponse_result = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\AddCommunicationToCaseResponse' {Maybe Bool
result :: Maybe Bool
$sel:result:AddCommunicationToCaseResponse' :: AddCommunicationToCaseResponse -> Maybe Bool
result} -> Maybe Bool
result) (\s :: AddCommunicationToCaseResponse
s@AddCommunicationToCaseResponse' {} Maybe Bool
a -> AddCommunicationToCaseResponse
s {$sel:result:AddCommunicationToCaseResponse' :: Maybe Bool
result = Maybe Bool
a} :: AddCommunicationToCaseResponse)

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

instance
  Prelude.NFData
    AddCommunicationToCaseResponse
  where
  rnf :: AddCommunicationToCaseResponse -> ()
rnf AddCommunicationToCaseResponse' {Int
Maybe Bool
httpStatus :: Int
result :: Maybe Bool
$sel:httpStatus:AddCommunicationToCaseResponse' :: AddCommunicationToCaseResponse -> Int
$sel:result:AddCommunicationToCaseResponse' :: AddCommunicationToCaseResponse -> Maybe Bool
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Bool
result
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus