{-# 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.ConnectCases.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 specified Cases domain. Case system and custom
-- fields are taken as an array id\/value pairs with a declared data types.
--
-- @customer_id@ is a required field when creating a case.
module Amazonka.ConnectCases.CreateCase
  ( -- * Creating a Request
    CreateCase (..),
    newCreateCase,

    -- * Request Lenses
    createCase_clientToken,
    createCase_domainId,
    createCase_fields,
    createCase_templateId,

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

    -- * Response Lenses
    createCaseResponse_httpStatus,
    createCaseResponse_caseArn,
    createCaseResponse_caseId,
  )
where

import Amazonka.ConnectCases.Types
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

-- | /See:/ 'newCreateCase' smart constructor.
data CreateCase = CreateCase'
  { -- | A unique, case-sensitive identifier that you provide to ensure the
    -- idempotency of the request. If not provided, the Amazon Web Services SDK
    -- populates this field. For more information about idempotency, see
    -- <https://aws.amazon.com/builders-library/making-retries-safe-with-idempotent-APIs/ Making retries safe with idempotent APIs>.
    CreateCase -> Maybe Text
clientToken :: Prelude.Maybe Prelude.Text,
    -- | The unique identifier of the Cases domain.
    CreateCase -> Text
domainId :: Prelude.Text,
    -- | An array of objects with field ID (matching ListFields\/DescribeField)
    -- and value union data.
    CreateCase -> [FieldValue]
fields :: [FieldValue],
    -- | A unique identifier of a template.
    CreateCase -> Text
templateId :: 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:
--
-- 'clientToken', 'createCase_clientToken' - A unique, case-sensitive identifier that you provide to ensure the
-- idempotency of the request. If not provided, the Amazon Web Services SDK
-- populates this field. For more information about idempotency, see
-- <https://aws.amazon.com/builders-library/making-retries-safe-with-idempotent-APIs/ Making retries safe with idempotent APIs>.
--
-- 'domainId', 'createCase_domainId' - The unique identifier of the Cases domain.
--
-- 'fields', 'createCase_fields' - An array of objects with field ID (matching ListFields\/DescribeField)
-- and value union data.
--
-- 'templateId', 'createCase_templateId' - A unique identifier of a template.
newCreateCase ::
  -- | 'domainId'
  Prelude.Text ->
  -- | 'templateId'
  Prelude.Text ->
  CreateCase
newCreateCase :: Text -> Text -> CreateCase
newCreateCase Text
pDomainId_ Text
pTemplateId_ =
  CreateCase'
    { $sel:clientToken:CreateCase' :: Maybe Text
clientToken = forall a. Maybe a
Prelude.Nothing,
      $sel:domainId:CreateCase' :: Text
domainId = Text
pDomainId_,
      $sel:fields:CreateCase' :: [FieldValue]
fields = forall a. Monoid a => a
Prelude.mempty,
      $sel:templateId:CreateCase' :: Text
templateId = Text
pTemplateId_
    }

-- | A unique, case-sensitive identifier that you provide to ensure the
-- idempotency of the request. If not provided, the Amazon Web Services SDK
-- populates this field. For more information about idempotency, see
-- <https://aws.amazon.com/builders-library/making-retries-safe-with-idempotent-APIs/ Making retries safe with idempotent APIs>.
createCase_clientToken :: Lens.Lens' CreateCase (Prelude.Maybe Prelude.Text)
createCase_clientToken :: Lens' CreateCase (Maybe Text)
createCase_clientToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateCase' {Maybe Text
clientToken :: Maybe Text
$sel:clientToken:CreateCase' :: CreateCase -> Maybe Text
clientToken} -> Maybe Text
clientToken) (\s :: CreateCase
s@CreateCase' {} Maybe Text
a -> CreateCase
s {$sel:clientToken:CreateCase' :: Maybe Text
clientToken = Maybe Text
a} :: CreateCase)

-- | The unique identifier of the Cases domain.
createCase_domainId :: Lens.Lens' CreateCase Prelude.Text
createCase_domainId :: Lens' CreateCase Text
createCase_domainId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateCase' {Text
domainId :: Text
$sel:domainId:CreateCase' :: CreateCase -> Text
domainId} -> Text
domainId) (\s :: CreateCase
s@CreateCase' {} Text
a -> CreateCase
s {$sel:domainId:CreateCase' :: Text
domainId = Text
a} :: CreateCase)

-- | An array of objects with field ID (matching ListFields\/DescribeField)
-- and value union data.
createCase_fields :: Lens.Lens' CreateCase [FieldValue]
createCase_fields :: Lens' CreateCase [FieldValue]
createCase_fields = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateCase' {[FieldValue]
fields :: [FieldValue]
$sel:fields:CreateCase' :: CreateCase -> [FieldValue]
fields} -> [FieldValue]
fields) (\s :: CreateCase
s@CreateCase' {} [FieldValue]
a -> CreateCase
s {$sel:fields:CreateCase' :: [FieldValue]
fields = [FieldValue]
a} :: CreateCase) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Lens.coerced

-- | A unique identifier of a template.
createCase_templateId :: Lens.Lens' CreateCase Prelude.Text
createCase_templateId :: Lens' CreateCase Text
createCase_templateId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateCase' {Text
templateId :: Text
$sel:templateId:CreateCase' :: CreateCase -> Text
templateId} -> Text
templateId) (\s :: CreateCase
s@CreateCase' {} Text
a -> CreateCase
s {$sel:templateId:CreateCase' :: Text
templateId = 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 ->
          Int -> Text -> Text -> CreateCaseResponse
CreateCaseResponse'
            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
"caseArn")
            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
"caseId")
      )

instance Prelude.Hashable CreateCase where
  hashWithSalt :: Int -> CreateCase -> Int
hashWithSalt Int
_salt CreateCase' {[FieldValue]
Maybe Text
Text
templateId :: Text
fields :: [FieldValue]
domainId :: Text
clientToken :: Maybe Text
$sel:templateId:CreateCase' :: CreateCase -> Text
$sel:fields:CreateCase' :: CreateCase -> [FieldValue]
$sel:domainId:CreateCase' :: CreateCase -> Text
$sel:clientToken:CreateCase' :: CreateCase -> Maybe Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
clientToken
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
domainId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` [FieldValue]
fields
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
templateId

instance Prelude.NFData CreateCase where
  rnf :: CreateCase -> ()
rnf CreateCase' {[FieldValue]
Maybe Text
Text
templateId :: Text
fields :: [FieldValue]
domainId :: Text
clientToken :: Maybe Text
$sel:templateId:CreateCase' :: CreateCase -> Text
$sel:fields:CreateCase' :: CreateCase -> [FieldValue]
$sel:domainId:CreateCase' :: CreateCase -> Text
$sel:clientToken:CreateCase' :: CreateCase -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
clientToken
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
domainId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf [FieldValue]
fields
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
templateId

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
"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' {[FieldValue]
Maybe Text
Text
templateId :: Text
fields :: [FieldValue]
domainId :: Text
clientToken :: Maybe Text
$sel:templateId:CreateCase' :: CreateCase -> Text
$sel:fields:CreateCase' :: CreateCase -> [FieldValue]
$sel:domainId:CreateCase' :: CreateCase -> Text
$sel:clientToken:CreateCase' :: CreateCase -> Maybe Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"clientToken" 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
clientToken,
            forall a. a -> Maybe a
Prelude.Just (Key
"fields" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= [FieldValue]
fields),
            forall a. a -> Maybe a
Prelude.Just (Key
"templateId" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
templateId)
          ]
      )

instance Data.ToPath CreateCase where
  toPath :: CreateCase -> ByteString
toPath CreateCase' {[FieldValue]
Maybe Text
Text
templateId :: Text
fields :: [FieldValue]
domainId :: Text
clientToken :: Maybe Text
$sel:templateId:CreateCase' :: CreateCase -> Text
$sel:fields:CreateCase' :: CreateCase -> [FieldValue]
$sel:domainId:CreateCase' :: CreateCase -> Text
$sel:clientToken:CreateCase' :: CreateCase -> Maybe Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ByteString
"/domains/", forall a. ToByteString a => a -> ByteString
Data.toBS Text
domainId, ByteString
"/cases"]

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

-- | /See:/ 'newCreateCaseResponse' smart constructor.
data CreateCaseResponse = CreateCaseResponse'
  { -- | The response's http status code.
    CreateCaseResponse -> Int
httpStatus :: Prelude.Int,
    -- | The Amazon Resource Name (ARN) of the case.
    CreateCaseResponse -> Text
caseArn :: Prelude.Text,
    -- | A unique identifier of the case.
    CreateCaseResponse -> Text
caseId :: Prelude.Text
  }
  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:
--
-- 'httpStatus', 'createCaseResponse_httpStatus' - The response's http status code.
--
-- 'caseArn', 'createCaseResponse_caseArn' - The Amazon Resource Name (ARN) of the case.
--
-- 'caseId', 'createCaseResponse_caseId' - A unique identifier of the case.
newCreateCaseResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  -- | 'caseArn'
  Prelude.Text ->
  -- | 'caseId'
  Prelude.Text ->
  CreateCaseResponse
newCreateCaseResponse :: Int -> Text -> Text -> CreateCaseResponse
newCreateCaseResponse Int
pHttpStatus_ Text
pCaseArn_ Text
pCaseId_ =
  CreateCaseResponse'
    { $sel:httpStatus:CreateCaseResponse' :: Int
httpStatus = Int
pHttpStatus_,
      $sel:caseArn:CreateCaseResponse' :: Text
caseArn = Text
pCaseArn_,
      $sel:caseId:CreateCaseResponse' :: Text
caseId = Text
pCaseId_
    }

-- | 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)

-- | The Amazon Resource Name (ARN) of the case.
createCaseResponse_caseArn :: Lens.Lens' CreateCaseResponse Prelude.Text
createCaseResponse_caseArn :: Lens' CreateCaseResponse Text
createCaseResponse_caseArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateCaseResponse' {Text
caseArn :: Text
$sel:caseArn:CreateCaseResponse' :: CreateCaseResponse -> Text
caseArn} -> Text
caseArn) (\s :: CreateCaseResponse
s@CreateCaseResponse' {} Text
a -> CreateCaseResponse
s {$sel:caseArn:CreateCaseResponse' :: Text
caseArn = Text
a} :: CreateCaseResponse)

-- | A unique identifier of the case.
createCaseResponse_caseId :: Lens.Lens' CreateCaseResponse Prelude.Text
createCaseResponse_caseId :: Lens' CreateCaseResponse Text
createCaseResponse_caseId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateCaseResponse' {Text
caseId :: Text
$sel:caseId:CreateCaseResponse' :: CreateCaseResponse -> Text
caseId} -> Text
caseId) (\s :: CreateCaseResponse
s@CreateCaseResponse' {} Text
a -> CreateCaseResponse
s {$sel:caseId:CreateCaseResponse' :: Text
caseId = Text
a} :: CreateCaseResponse)

instance Prelude.NFData CreateCaseResponse where
  rnf :: CreateCaseResponse -> ()
rnf CreateCaseResponse' {Int
Text
caseId :: Text
caseArn :: Text
httpStatus :: Int
$sel:caseId:CreateCaseResponse' :: CreateCaseResponse -> Text
$sel:caseArn:CreateCaseResponse' :: CreateCaseResponse -> Text
$sel:httpStatus:CreateCaseResponse' :: CreateCaseResponse -> 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
caseArn
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
caseId