{-# 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.CreateCase
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Creates a case in the Amazon Web Services Support Center. This operation
-- is similar to how you create a case in the Amazon Web Services Support
-- Center
-- <https://console.aws.amazon.com/support/home#/case/create Create Case>
-- page.
--
-- The Amazon Web Services Support API doesn\'t support requesting service
-- limit increases. You can submit a service limit increase in the
-- following ways:
--
-- -   Submit a request from the Amazon Web Services Support Center
--     <https://console.aws.amazon.com/support/home#/case/create Create Case>
--     page.
--
-- -   Use the Service Quotas
--     <https://docs.aws.amazon.com/servicequotas/2019-06-24/apireference/API_RequestServiceQuotaIncrease.html RequestServiceQuotaIncrease>
--     operation.
--
-- A successful @CreateCase@ request returns an Amazon Web Services Support
-- case number. You can use the DescribeCases operation and specify the
-- case number to get existing Amazon Web Services Support cases. After you
-- create a case, use the AddCommunicationToCase operation to add
-- additional communication or attachments to an existing case.
--
-- The @caseId@ is separate from the @displayId@ that appears in the
-- <https://console.aws.amazon.com/support Amazon Web Services Support Center>.
-- Use the DescribeCases operation to get the @displayId@.
--
-- -   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.CreateCase
  ( -- * Creating a Request
    CreateCase (..),
    newCreateCase,

    -- * Request Lenses
    createCase_attachmentSetId,
    createCase_categoryCode,
    createCase_ccEmailAddresses,
    createCase_issueType,
    createCase_language,
    createCase_serviceCode,
    createCase_severityCode,
    createCase_subject,
    createCase_communicationBody,

    -- * Destructuring the Response
    CreateCaseResponse (..),
    newCreateCaseResponse,

    -- * Response Lenses
    createCaseResponse_caseId,
    createCaseResponse_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:/ 'newCreateCase' smart constructor.
data CreateCase = CreateCase'
  { -- | The ID of a set of one or more attachments for the case. Create the set
    -- by using the AddAttachmentsToSet operation.
    CreateCase -> Maybe Text
attachmentSetId :: Prelude.Maybe Prelude.Text,
    -- | The category of problem for the support case. You also use the
    -- DescribeServices operation to get the category code for a service. Each
    -- Amazon Web Services service defines its own set of category codes.
    CreateCase -> Maybe Text
categoryCode :: Prelude.Maybe Prelude.Text,
    -- | A list of email addresses that Amazon Web Services Support copies on
    -- case correspondence. Amazon Web Services Support identifies the account
    -- that creates the case when you specify your Amazon Web Services
    -- credentials in an HTTP POST method or use the
    -- <http://aws.amazon.com/tools/ Amazon Web Services SDKs>.
    CreateCase -> Maybe [Text]
ccEmailAddresses :: Prelude.Maybe [Prelude.Text],
    -- | The type of issue for the case. You can specify @customer-service@ or
    -- @technical@. If you don\'t specify a value, the default is @technical@.
    CreateCase -> Maybe Text
issueType :: Prelude.Maybe Prelude.Text,
    -- | The language in which Amazon Web Services Support handles the case.
    -- Amazon Web Services Support currently supports English (\"en\") and
    -- Japanese (\"ja\"). You must specify the ISO 639-1 code for the
    -- @language@ parameter if you want support in that language.
    CreateCase -> Maybe Text
language :: Prelude.Maybe Prelude.Text,
    -- | The code for the Amazon Web Services service. You can use the
    -- DescribeServices operation to get the possible @serviceCode@ values.
    CreateCase -> Maybe Text
serviceCode :: Prelude.Maybe Prelude.Text,
    -- | A value that indicates the urgency of the case. This value determines
    -- the response time according to your service level agreement with Amazon
    -- Web Services Support. You can use the DescribeSeverityLevels operation
    -- to get the possible values for @severityCode@.
    --
    -- For more information, see SeverityLevel and
    -- <https://docs.aws.amazon.com/awssupport/latest/user/getting-started.html#choosing-severity Choosing a Severity>
    -- in the /Amazon Web Services Support User Guide/.
    --
    -- The availability of severity levels depends on the support plan for the
    -- Amazon Web Services account.
    CreateCase -> Maybe Text
severityCode :: Prelude.Maybe Prelude.Text,
    -- | The title of the support case. The title appears in the __Subject__
    -- field on the Amazon Web Services Support Center
    -- <https://console.aws.amazon.com/support/home#/case/create Create Case>
    -- page.
    CreateCase -> Text
subject :: Prelude.Text,
    -- | The communication body text that describes the issue. This text appears
    -- in the __Description__ field on the Amazon Web Services Support Center
    -- <https://console.aws.amazon.com/support/home#/case/create Create Case>
    -- page.
    CreateCase -> Text
communicationBody :: Prelude.Text
  }
  deriving (CreateCase -> CreateCase -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateCase -> CreateCase -> Bool
$c/= :: CreateCase -> CreateCase -> Bool
== :: CreateCase -> CreateCase -> Bool
$c== :: CreateCase -> CreateCase -> Bool
Prelude.Eq, ReadPrec [CreateCase]
ReadPrec CreateCase
Int -> ReadS CreateCase
ReadS [CreateCase]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CreateCase]
$creadListPrec :: ReadPrec [CreateCase]
readPrec :: ReadPrec CreateCase
$creadPrec :: ReadPrec CreateCase
readList :: ReadS [CreateCase]
$creadList :: ReadS [CreateCase]
readsPrec :: Int -> ReadS CreateCase
$creadsPrec :: Int -> ReadS CreateCase
Prelude.Read, Int -> CreateCase -> ShowS
[CreateCase] -> ShowS
CreateCase -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateCase] -> ShowS
$cshowList :: [CreateCase] -> ShowS
show :: CreateCase -> String
$cshow :: CreateCase -> String
showsPrec :: Int -> CreateCase -> ShowS
$cshowsPrec :: Int -> CreateCase -> ShowS
Prelude.Show, forall x. Rep CreateCase x -> CreateCase
forall x. CreateCase -> Rep CreateCase x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CreateCase x -> CreateCase
$cfrom :: forall x. CreateCase -> Rep CreateCase x
Prelude.Generic)

-- |
-- Create a value of 'CreateCase' 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', 'createCase_attachmentSetId' - The ID of a set of one or more attachments for the case. Create the set
-- by using the AddAttachmentsToSet operation.
--
-- 'categoryCode', 'createCase_categoryCode' - The category of problem for the support case. You also use the
-- DescribeServices operation to get the category code for a service. Each
-- Amazon Web Services service defines its own set of category codes.
--
-- 'ccEmailAddresses', 'createCase_ccEmailAddresses' - A list of email addresses that Amazon Web Services Support copies on
-- case correspondence. Amazon Web Services Support identifies the account
-- that creates the case when you specify your Amazon Web Services
-- credentials in an HTTP POST method or use the
-- <http://aws.amazon.com/tools/ Amazon Web Services SDKs>.
--
-- 'issueType', 'createCase_issueType' - The type of issue for the case. You can specify @customer-service@ or
-- @technical@. If you don\'t specify a value, the default is @technical@.
--
-- 'language', 'createCase_language' - The language in which Amazon Web Services Support handles the case.
-- Amazon Web Services Support currently supports English (\"en\") and
-- Japanese (\"ja\"). You must specify the ISO 639-1 code for the
-- @language@ parameter if you want support in that language.
--
-- 'serviceCode', 'createCase_serviceCode' - The code for the Amazon Web Services service. You can use the
-- DescribeServices operation to get the possible @serviceCode@ values.
--
-- 'severityCode', 'createCase_severityCode' - A value that indicates the urgency of the case. This value determines
-- the response time according to your service level agreement with Amazon
-- Web Services Support. You can use the DescribeSeverityLevels operation
-- to get the possible values for @severityCode@.
--
-- For more information, see SeverityLevel and
-- <https://docs.aws.amazon.com/awssupport/latest/user/getting-started.html#choosing-severity Choosing a Severity>
-- in the /Amazon Web Services Support User Guide/.
--
-- The availability of severity levels depends on the support plan for the
-- Amazon Web Services account.
--
-- 'subject', 'createCase_subject' - The title of the support case. The title appears in the __Subject__
-- field on the Amazon Web Services Support Center
-- <https://console.aws.amazon.com/support/home#/case/create Create Case>
-- page.
--
-- 'communicationBody', 'createCase_communicationBody' - The communication body text that describes the issue. This text appears
-- in the __Description__ field on the Amazon Web Services Support Center
-- <https://console.aws.amazon.com/support/home#/case/create Create Case>
-- page.
newCreateCase ::
  -- | 'subject'
  Prelude.Text ->
  -- | 'communicationBody'
  Prelude.Text ->
  CreateCase
newCreateCase :: Text -> Text -> CreateCase
newCreateCase Text
pSubject_ Text
pCommunicationBody_ =
  CreateCase'
    { $sel:attachmentSetId:CreateCase' :: Maybe Text
attachmentSetId = forall a. Maybe a
Prelude.Nothing,
      $sel:categoryCode:CreateCase' :: Maybe Text
categoryCode = forall a. Maybe a
Prelude.Nothing,
      $sel:ccEmailAddresses:CreateCase' :: Maybe [Text]
ccEmailAddresses = forall a. Maybe a
Prelude.Nothing,
      $sel:issueType:CreateCase' :: Maybe Text
issueType = forall a. Maybe a
Prelude.Nothing,
      $sel:language:CreateCase' :: Maybe Text
language = forall a. Maybe a
Prelude.Nothing,
      $sel:serviceCode:CreateCase' :: Maybe Text
serviceCode = forall a. Maybe a
Prelude.Nothing,
      $sel:severityCode:CreateCase' :: Maybe Text
severityCode = forall a. Maybe a
Prelude.Nothing,
      $sel:subject:CreateCase' :: Text
subject = Text
pSubject_,
      $sel:communicationBody:CreateCase' :: Text
communicationBody = Text
pCommunicationBody_
    }

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

-- | The category of problem for the support case. You also use the
-- DescribeServices operation to get the category code for a service. Each
-- Amazon Web Services service defines its own set of category codes.
createCase_categoryCode :: Lens.Lens' CreateCase (Prelude.Maybe Prelude.Text)
createCase_categoryCode :: Lens' CreateCase (Maybe Text)
createCase_categoryCode = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateCase' {Maybe Text
categoryCode :: Maybe Text
$sel:categoryCode:CreateCase' :: CreateCase -> Maybe Text
categoryCode} -> Maybe Text
categoryCode) (\s :: CreateCase
s@CreateCase' {} Maybe Text
a -> CreateCase
s {$sel:categoryCode:CreateCase' :: Maybe Text
categoryCode = Maybe Text
a} :: CreateCase)

-- | A list of email addresses that Amazon Web Services Support copies on
-- case correspondence. Amazon Web Services Support identifies the account
-- that creates the case when you specify your Amazon Web Services
-- credentials in an HTTP POST method or use the
-- <http://aws.amazon.com/tools/ Amazon Web Services SDKs>.
createCase_ccEmailAddresses :: Lens.Lens' CreateCase (Prelude.Maybe [Prelude.Text])
createCase_ccEmailAddresses :: Lens' CreateCase (Maybe [Text])
createCase_ccEmailAddresses = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateCase' {Maybe [Text]
ccEmailAddresses :: Maybe [Text]
$sel:ccEmailAddresses:CreateCase' :: CreateCase -> Maybe [Text]
ccEmailAddresses} -> Maybe [Text]
ccEmailAddresses) (\s :: CreateCase
s@CreateCase' {} Maybe [Text]
a -> CreateCase
s {$sel:ccEmailAddresses:CreateCase' :: Maybe [Text]
ccEmailAddresses = Maybe [Text]
a} :: CreateCase) 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 type of issue for the case. You can specify @customer-service@ or
-- @technical@. If you don\'t specify a value, the default is @technical@.
createCase_issueType :: Lens.Lens' CreateCase (Prelude.Maybe Prelude.Text)
createCase_issueType :: Lens' CreateCase (Maybe Text)
createCase_issueType = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateCase' {Maybe Text
issueType :: Maybe Text
$sel:issueType:CreateCase' :: CreateCase -> Maybe Text
issueType} -> Maybe Text
issueType) (\s :: CreateCase
s@CreateCase' {} Maybe Text
a -> CreateCase
s {$sel:issueType:CreateCase' :: Maybe Text
issueType = Maybe Text
a} :: CreateCase)

-- | The language in which Amazon Web Services Support handles the case.
-- Amazon Web Services Support currently supports English (\"en\") and
-- Japanese (\"ja\"). You must specify the ISO 639-1 code for the
-- @language@ parameter if you want support in that language.
createCase_language :: Lens.Lens' CreateCase (Prelude.Maybe Prelude.Text)
createCase_language :: Lens' CreateCase (Maybe Text)
createCase_language = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateCase' {Maybe Text
language :: Maybe Text
$sel:language:CreateCase' :: CreateCase -> Maybe Text
language} -> Maybe Text
language) (\s :: CreateCase
s@CreateCase' {} Maybe Text
a -> CreateCase
s {$sel:language:CreateCase' :: Maybe Text
language = Maybe Text
a} :: CreateCase)

-- | The code for the Amazon Web Services service. You can use the
-- DescribeServices operation to get the possible @serviceCode@ values.
createCase_serviceCode :: Lens.Lens' CreateCase (Prelude.Maybe Prelude.Text)
createCase_serviceCode :: Lens' CreateCase (Maybe Text)
createCase_serviceCode = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateCase' {Maybe Text
serviceCode :: Maybe Text
$sel:serviceCode:CreateCase' :: CreateCase -> Maybe Text
serviceCode} -> Maybe Text
serviceCode) (\s :: CreateCase
s@CreateCase' {} Maybe Text
a -> CreateCase
s {$sel:serviceCode:CreateCase' :: Maybe Text
serviceCode = Maybe Text
a} :: CreateCase)

-- | A value that indicates the urgency of the case. This value determines
-- the response time according to your service level agreement with Amazon
-- Web Services Support. You can use the DescribeSeverityLevels operation
-- to get the possible values for @severityCode@.
--
-- For more information, see SeverityLevel and
-- <https://docs.aws.amazon.com/awssupport/latest/user/getting-started.html#choosing-severity Choosing a Severity>
-- in the /Amazon Web Services Support User Guide/.
--
-- The availability of severity levels depends on the support plan for the
-- Amazon Web Services account.
createCase_severityCode :: Lens.Lens' CreateCase (Prelude.Maybe Prelude.Text)
createCase_severityCode :: Lens' CreateCase (Maybe Text)
createCase_severityCode = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateCase' {Maybe Text
severityCode :: Maybe Text
$sel:severityCode:CreateCase' :: CreateCase -> Maybe Text
severityCode} -> Maybe Text
severityCode) (\s :: CreateCase
s@CreateCase' {} Maybe Text
a -> CreateCase
s {$sel:severityCode:CreateCase' :: Maybe Text
severityCode = Maybe Text
a} :: CreateCase)

-- | The title of the support case. The title appears in the __Subject__
-- field on the Amazon Web Services Support Center
-- <https://console.aws.amazon.com/support/home#/case/create Create Case>
-- page.
createCase_subject :: Lens.Lens' CreateCase Prelude.Text
createCase_subject :: Lens' CreateCase Text
createCase_subject = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateCase' {Text
subject :: Text
$sel:subject:CreateCase' :: CreateCase -> Text
subject} -> Text
subject) (\s :: CreateCase
s@CreateCase' {} Text
a -> CreateCase
s {$sel:subject:CreateCase' :: Text
subject = Text
a} :: CreateCase)

-- | The communication body text that describes the issue. This text appears
-- in the __Description__ field on the Amazon Web Services Support Center
-- <https://console.aws.amazon.com/support/home#/case/create Create Case>
-- page.
createCase_communicationBody :: Lens.Lens' CreateCase Prelude.Text
createCase_communicationBody :: Lens' CreateCase Text
createCase_communicationBody = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateCase' {Text
communicationBody :: Text
$sel:communicationBody:CreateCase' :: CreateCase -> Text
communicationBody} -> Text
communicationBody) (\s :: CreateCase
s@CreateCase' {} Text
a -> CreateCase
s {$sel:communicationBody:CreateCase' :: Text
communicationBody = Text
a} :: CreateCase)

instance Core.AWSRequest CreateCase where
  type AWSResponse CreateCase = CreateCaseResponse
  request :: (Service -> Service) -> CreateCase -> Request CreateCase
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 CreateCase
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse CreateCase)))
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 Text -> Int -> CreateCaseResponse
CreateCaseResponse'
            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
"caseId")
            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 CreateCase where
  hashWithSalt :: Int -> CreateCase -> Int
hashWithSalt Int
_salt CreateCase' {Maybe [Text]
Maybe Text
Text
communicationBody :: Text
subject :: Text
severityCode :: Maybe Text
serviceCode :: Maybe Text
language :: Maybe Text
issueType :: Maybe Text
ccEmailAddresses :: Maybe [Text]
categoryCode :: Maybe Text
attachmentSetId :: Maybe Text
$sel:communicationBody:CreateCase' :: CreateCase -> Text
$sel:subject:CreateCase' :: CreateCase -> Text
$sel:severityCode:CreateCase' :: CreateCase -> Maybe Text
$sel:serviceCode:CreateCase' :: CreateCase -> Maybe Text
$sel:language:CreateCase' :: CreateCase -> Maybe Text
$sel:issueType:CreateCase' :: CreateCase -> Maybe Text
$sel:ccEmailAddresses:CreateCase' :: CreateCase -> Maybe [Text]
$sel:categoryCode:CreateCase' :: CreateCase -> Maybe Text
$sel:attachmentSetId:CreateCase' :: CreateCase -> 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
categoryCode
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [Text]
ccEmailAddresses
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
issueType
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
language
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
serviceCode
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
severityCode
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
subject
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
communicationBody

instance Prelude.NFData CreateCase where
  rnf :: CreateCase -> ()
rnf CreateCase' {Maybe [Text]
Maybe Text
Text
communicationBody :: Text
subject :: Text
severityCode :: Maybe Text
serviceCode :: Maybe Text
language :: Maybe Text
issueType :: Maybe Text
ccEmailAddresses :: Maybe [Text]
categoryCode :: Maybe Text
attachmentSetId :: Maybe Text
$sel:communicationBody:CreateCase' :: CreateCase -> Text
$sel:subject:CreateCase' :: CreateCase -> Text
$sel:severityCode:CreateCase' :: CreateCase -> Maybe Text
$sel:serviceCode:CreateCase' :: CreateCase -> Maybe Text
$sel:language:CreateCase' :: CreateCase -> Maybe Text
$sel:issueType:CreateCase' :: CreateCase -> Maybe Text
$sel:ccEmailAddresses:CreateCase' :: CreateCase -> Maybe [Text]
$sel:categoryCode:CreateCase' :: CreateCase -> Maybe Text
$sel:attachmentSetId:CreateCase' :: CreateCase -> 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
categoryCode
      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 Maybe Text
issueType
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
language
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
serviceCode
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
severityCode
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
subject
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
communicationBody

instance Data.ToHeaders CreateCase where
  toHeaders :: CreateCase -> 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.CreateCase" ::
                          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 CreateCase where
  toJSON :: CreateCase -> Value
toJSON CreateCase' {Maybe [Text]
Maybe Text
Text
communicationBody :: Text
subject :: Text
severityCode :: Maybe Text
serviceCode :: Maybe Text
language :: Maybe Text
issueType :: Maybe Text
ccEmailAddresses :: Maybe [Text]
categoryCode :: Maybe Text
attachmentSetId :: Maybe Text
$sel:communicationBody:CreateCase' :: CreateCase -> Text
$sel:subject:CreateCase' :: CreateCase -> Text
$sel:severityCode:CreateCase' :: CreateCase -> Maybe Text
$sel:serviceCode:CreateCase' :: CreateCase -> Maybe Text
$sel:language:CreateCase' :: CreateCase -> Maybe Text
$sel:issueType:CreateCase' :: CreateCase -> Maybe Text
$sel:ccEmailAddresses:CreateCase' :: CreateCase -> Maybe [Text]
$sel:categoryCode:CreateCase' :: CreateCase -> Maybe Text
$sel:attachmentSetId:CreateCase' :: CreateCase -> 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
"categoryCode" 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
categoryCode,
            (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,
            (Key
"issueType" 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
issueType,
            (Key
"language" 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
language,
            (Key
"serviceCode" 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
serviceCode,
            (Key
"severityCode" 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
severityCode,
            forall a. a -> Maybe a
Prelude.Just (Key
"subject" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
subject),
            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 CreateCase where
  toPath :: CreateCase -> ByteString
toPath = forall a b. a -> b -> a
Prelude.const ByteString
"/"

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

-- | The support case ID returned by a successful completion of the
-- CreateCase operation.
--
-- /See:/ 'newCreateCaseResponse' smart constructor.
data CreateCaseResponse = CreateCaseResponse'
  { -- | The support case ID requested or returned in the call. The case ID is an
    -- alphanumeric string in the following format:
    -- case-/12345678910-2013-c4c1d2bf33c5cf47/
    CreateCaseResponse -> Maybe Text
caseId :: Prelude.Maybe Prelude.Text,
    -- | The response's http status code.
    CreateCaseResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (CreateCaseResponse -> CreateCaseResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateCaseResponse -> CreateCaseResponse -> Bool
$c/= :: CreateCaseResponse -> CreateCaseResponse -> Bool
== :: CreateCaseResponse -> CreateCaseResponse -> Bool
$c== :: CreateCaseResponse -> CreateCaseResponse -> Bool
Prelude.Eq, ReadPrec [CreateCaseResponse]
ReadPrec CreateCaseResponse
Int -> ReadS CreateCaseResponse
ReadS [CreateCaseResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CreateCaseResponse]
$creadListPrec :: ReadPrec [CreateCaseResponse]
readPrec :: ReadPrec CreateCaseResponse
$creadPrec :: ReadPrec CreateCaseResponse
readList :: ReadS [CreateCaseResponse]
$creadList :: ReadS [CreateCaseResponse]
readsPrec :: Int -> ReadS CreateCaseResponse
$creadsPrec :: Int -> ReadS CreateCaseResponse
Prelude.Read, Int -> CreateCaseResponse -> ShowS
[CreateCaseResponse] -> ShowS
CreateCaseResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateCaseResponse] -> ShowS
$cshowList :: [CreateCaseResponse] -> ShowS
show :: CreateCaseResponse -> String
$cshow :: CreateCaseResponse -> String
showsPrec :: Int -> CreateCaseResponse -> ShowS
$cshowsPrec :: Int -> CreateCaseResponse -> ShowS
Prelude.Show, forall x. Rep CreateCaseResponse x -> CreateCaseResponse
forall x. CreateCaseResponse -> Rep CreateCaseResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CreateCaseResponse x -> CreateCaseResponse
$cfrom :: forall x. CreateCaseResponse -> Rep CreateCaseResponse x
Prelude.Generic)

-- |
-- Create a value of 'CreateCaseResponse' 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:
--
-- 'caseId', 'createCaseResponse_caseId' - The support case ID requested or returned in the call. The case ID is an
-- alphanumeric string in the following format:
-- case-/12345678910-2013-c4c1d2bf33c5cf47/
--
-- 'httpStatus', 'createCaseResponse_httpStatus' - The response's http status code.
newCreateCaseResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  CreateCaseResponse
newCreateCaseResponse :: Int -> CreateCaseResponse
newCreateCaseResponse Int
pHttpStatus_ =
  CreateCaseResponse'
    { $sel:caseId:CreateCaseResponse' :: Maybe Text
caseId = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:CreateCaseResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

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

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

instance Prelude.NFData CreateCaseResponse where
  rnf :: CreateCaseResponse -> ()
rnf CreateCaseResponse' {Int
Maybe Text
httpStatus :: Int
caseId :: Maybe Text
$sel:httpStatus:CreateCaseResponse' :: CreateCaseResponse -> Int
$sel:caseId:CreateCaseResponse' :: CreateCaseResponse -> Maybe Text
..} =
    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 Int
httpStatus