{-# 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.UpdateCase
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Updates the values of fields on a case. Fields to be updated are
-- received as an array of id\/value pairs identical to the @CreateCase@
-- input .
--
-- If the action is successful, the service sends back an HTTP 200 response
-- with an empty HTTP body.
module Amazonka.ConnectCases.UpdateCase
  ( -- * Creating a Request
    UpdateCase (..),
    newUpdateCase,

    -- * Request Lenses
    updateCase_caseId,
    updateCase_domainId,
    updateCase_fields,

    -- * Destructuring the Response
    UpdateCaseResponse (..),
    newUpdateCaseResponse,

    -- * Response Lenses
    updateCaseResponse_httpStatus,
  )
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:/ 'newUpdateCase' smart constructor.
data UpdateCase = UpdateCase'
  { -- | A unique identifier of the case.
    UpdateCase -> Text
caseId :: Prelude.Text,
    -- | The unique identifier of the Cases domain.
    UpdateCase -> Text
domainId :: Prelude.Text,
    -- | An array of objects with @fieldId@ (matching ListFields\/DescribeField)
    -- and value union data, structured identical to @CreateCase@.
    UpdateCase -> [FieldValue]
fields :: [FieldValue]
  }
  deriving (UpdateCase -> UpdateCase -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UpdateCase -> UpdateCase -> Bool
$c/= :: UpdateCase -> UpdateCase -> Bool
== :: UpdateCase -> UpdateCase -> Bool
$c== :: UpdateCase -> UpdateCase -> Bool
Prelude.Eq, ReadPrec [UpdateCase]
ReadPrec UpdateCase
Int -> ReadS UpdateCase
ReadS [UpdateCase]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [UpdateCase]
$creadListPrec :: ReadPrec [UpdateCase]
readPrec :: ReadPrec UpdateCase
$creadPrec :: ReadPrec UpdateCase
readList :: ReadS [UpdateCase]
$creadList :: ReadS [UpdateCase]
readsPrec :: Int -> ReadS UpdateCase
$creadsPrec :: Int -> ReadS UpdateCase
Prelude.Read, Int -> UpdateCase -> ShowS
[UpdateCase] -> ShowS
UpdateCase -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UpdateCase] -> ShowS
$cshowList :: [UpdateCase] -> ShowS
show :: UpdateCase -> String
$cshow :: UpdateCase -> String
showsPrec :: Int -> UpdateCase -> ShowS
$cshowsPrec :: Int -> UpdateCase -> ShowS
Prelude.Show, forall x. Rep UpdateCase x -> UpdateCase
forall x. UpdateCase -> Rep UpdateCase x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep UpdateCase x -> UpdateCase
$cfrom :: forall x. UpdateCase -> Rep UpdateCase x
Prelude.Generic)

-- |
-- Create a value of 'UpdateCase' 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', 'updateCase_caseId' - A unique identifier of the case.
--
-- 'domainId', 'updateCase_domainId' - The unique identifier of the Cases domain.
--
-- 'fields', 'updateCase_fields' - An array of objects with @fieldId@ (matching ListFields\/DescribeField)
-- and value union data, structured identical to @CreateCase@.
newUpdateCase ::
  -- | 'caseId'
  Prelude.Text ->
  -- | 'domainId'
  Prelude.Text ->
  UpdateCase
newUpdateCase :: Text -> Text -> UpdateCase
newUpdateCase Text
pCaseId_ Text
pDomainId_ =
  UpdateCase'
    { $sel:caseId:UpdateCase' :: Text
caseId = Text
pCaseId_,
      $sel:domainId:UpdateCase' :: Text
domainId = Text
pDomainId_,
      $sel:fields:UpdateCase' :: [FieldValue]
fields = forall a. Monoid a => a
Prelude.mempty
    }

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

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

-- | An array of objects with @fieldId@ (matching ListFields\/DescribeField)
-- and value union data, structured identical to @CreateCase@.
updateCase_fields :: Lens.Lens' UpdateCase [FieldValue]
updateCase_fields :: Lens' UpdateCase [FieldValue]
updateCase_fields = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateCase' {[FieldValue]
fields :: [FieldValue]
$sel:fields:UpdateCase' :: UpdateCase -> [FieldValue]
fields} -> [FieldValue]
fields) (\s :: UpdateCase
s@UpdateCase' {} [FieldValue]
a -> UpdateCase
s {$sel:fields:UpdateCase' :: [FieldValue]
fields = [FieldValue]
a} :: UpdateCase) 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

instance Core.AWSRequest UpdateCase where
  type AWSResponse UpdateCase = UpdateCaseResponse
  request :: (Service -> Service) -> UpdateCase -> Request UpdateCase
request Service -> Service
overrides =
    forall a. (ToRequest a, ToJSON a) => Service -> a -> Request a
Request.putJSON (Service -> Service
overrides Service
defaultService)
  response :: forall (m :: * -> *).
MonadResource m =>
(ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy UpdateCase
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse UpdateCase)))
response =
    forall (m :: * -> *) a.
MonadResource m =>
(Int -> ResponseHeaders -> () -> Either String (AWSResponse a))
-> (ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy a
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse a)))
Response.receiveEmpty
      ( \Int
s ResponseHeaders
h ()
x ->
          Int -> UpdateCaseResponse
UpdateCaseResponse'
            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))
      )

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

instance Prelude.NFData UpdateCase where
  rnf :: UpdateCase -> ()
rnf UpdateCase' {[FieldValue]
Text
fields :: [FieldValue]
domainId :: Text
caseId :: Text
$sel:fields:UpdateCase' :: UpdateCase -> [FieldValue]
$sel:domainId:UpdateCase' :: UpdateCase -> Text
$sel:caseId:UpdateCase' :: UpdateCase -> Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Text
caseId
      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

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

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

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

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

-- |
-- Create a value of 'UpdateCaseResponse' 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', 'updateCaseResponse_httpStatus' - The response's http status code.
newUpdateCaseResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  UpdateCaseResponse
newUpdateCaseResponse :: Int -> UpdateCaseResponse
newUpdateCaseResponse Int
pHttpStatus_ =
  UpdateCaseResponse' {$sel:httpStatus:UpdateCaseResponse' :: Int
httpStatus = Int
pHttpStatus_}

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

instance Prelude.NFData UpdateCaseResponse where
  rnf :: UpdateCaseResponse -> ()
rnf UpdateCaseResponse' {Int
httpStatus :: Int
$sel:httpStatus:UpdateCaseResponse' :: UpdateCaseResponse -> Int
..} = forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus