{-# 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.GetCase
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Returns information about a specific case if it exists.
module Amazonka.ConnectCases.GetCase
  ( -- * Creating a Request
    GetCase (..),
    newGetCase,

    -- * Request Lenses
    getCase_nextToken,
    getCase_caseId,
    getCase_domainId,
    getCase_fields,

    -- * Destructuring the Response
    GetCaseResponse (..),
    newGetCaseResponse,

    -- * Response Lenses
    getCaseResponse_nextToken,
    getCaseResponse_tags,
    getCaseResponse_httpStatus,
    getCaseResponse_fields,
    getCaseResponse_templateId,
  )
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:/ 'newGetCase' smart constructor.
data GetCase = GetCase'
  { -- | The token for the next set of results. Use the value returned in the
    -- previous response in the next request to retrieve the next set of
    -- results.
    GetCase -> Maybe Text
nextToken :: Prelude.Maybe Prelude.Text,
    -- | A unique identifier of the case.
    GetCase -> Text
caseId :: Prelude.Text,
    -- | The unique identifier of the Cases domain.
    GetCase -> Text
domainId :: Prelude.Text,
    -- | A list of unique field identifiers.
    GetCase -> NonEmpty FieldIdentifier
fields :: Prelude.NonEmpty FieldIdentifier
  }
  deriving (GetCase -> GetCase -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetCase -> GetCase -> Bool
$c/= :: GetCase -> GetCase -> Bool
== :: GetCase -> GetCase -> Bool
$c== :: GetCase -> GetCase -> Bool
Prelude.Eq, ReadPrec [GetCase]
ReadPrec GetCase
Int -> ReadS GetCase
ReadS [GetCase]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GetCase]
$creadListPrec :: ReadPrec [GetCase]
readPrec :: ReadPrec GetCase
$creadPrec :: ReadPrec GetCase
readList :: ReadS [GetCase]
$creadList :: ReadS [GetCase]
readsPrec :: Int -> ReadS GetCase
$creadsPrec :: Int -> ReadS GetCase
Prelude.Read, Int -> GetCase -> ShowS
[GetCase] -> ShowS
GetCase -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetCase] -> ShowS
$cshowList :: [GetCase] -> ShowS
show :: GetCase -> String
$cshow :: GetCase -> String
showsPrec :: Int -> GetCase -> ShowS
$cshowsPrec :: Int -> GetCase -> ShowS
Prelude.Show, forall x. Rep GetCase x -> GetCase
forall x. GetCase -> Rep GetCase x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep GetCase x -> GetCase
$cfrom :: forall x. GetCase -> Rep GetCase x
Prelude.Generic)

-- |
-- Create a value of 'GetCase' 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:
--
-- 'nextToken', 'getCase_nextToken' - The token for the next set of results. Use the value returned in the
-- previous response in the next request to retrieve the next set of
-- results.
--
-- 'caseId', 'getCase_caseId' - A unique identifier of the case.
--
-- 'domainId', 'getCase_domainId' - The unique identifier of the Cases domain.
--
-- 'fields', 'getCase_fields' - A list of unique field identifiers.
newGetCase ::
  -- | 'caseId'
  Prelude.Text ->
  -- | 'domainId'
  Prelude.Text ->
  -- | 'fields'
  Prelude.NonEmpty FieldIdentifier ->
  GetCase
newGetCase :: Text -> Text -> NonEmpty FieldIdentifier -> GetCase
newGetCase Text
pCaseId_ Text
pDomainId_ NonEmpty FieldIdentifier
pFields_ =
  GetCase'
    { $sel:nextToken:GetCase' :: Maybe Text
nextToken = forall a. Maybe a
Prelude.Nothing,
      $sel:caseId:GetCase' :: Text
caseId = Text
pCaseId_,
      $sel:domainId:GetCase' :: Text
domainId = Text
pDomainId_,
      $sel:fields:GetCase' :: NonEmpty FieldIdentifier
fields = forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Lens.coerced forall t b. AReview t b -> b -> t
Lens.# NonEmpty FieldIdentifier
pFields_
    }

-- | The token for the next set of results. Use the value returned in the
-- previous response in the next request to retrieve the next set of
-- results.
getCase_nextToken :: Lens.Lens' GetCase (Prelude.Maybe Prelude.Text)
getCase_nextToken :: Lens' GetCase (Maybe Text)
getCase_nextToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetCase' {Maybe Text
nextToken :: Maybe Text
$sel:nextToken:GetCase' :: GetCase -> Maybe Text
nextToken} -> Maybe Text
nextToken) (\s :: GetCase
s@GetCase' {} Maybe Text
a -> GetCase
s {$sel:nextToken:GetCase' :: Maybe Text
nextToken = Maybe Text
a} :: GetCase)

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

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

-- | A list of unique field identifiers.
getCase_fields :: Lens.Lens' GetCase (Prelude.NonEmpty FieldIdentifier)
getCase_fields :: Lens' GetCase (NonEmpty FieldIdentifier)
getCase_fields = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetCase' {NonEmpty FieldIdentifier
fields :: NonEmpty FieldIdentifier
$sel:fields:GetCase' :: GetCase -> NonEmpty FieldIdentifier
fields} -> NonEmpty FieldIdentifier
fields) (\s :: GetCase
s@GetCase' {} NonEmpty FieldIdentifier
a -> GetCase
s {$sel:fields:GetCase' :: NonEmpty FieldIdentifier
fields = NonEmpty FieldIdentifier
a} :: GetCase) 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 GetCase where
  type AWSResponse GetCase = GetCaseResponse
  request :: (Service -> Service) -> GetCase -> Request GetCase
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 GetCase
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse GetCase)))
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
-> Maybe (HashMap Text Text)
-> Int
-> [FieldValue]
-> Text
-> GetCaseResponse
GetCaseResponse'
            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
"nextToken")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"tags" forall (f :: * -> *) a. Functor f => f (Maybe a) -> a -> f a
Core..!@ forall a. Monoid a => a
Prelude.mempty)
            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 (Maybe a)
Data..?> Key
"fields" forall (f :: * -> *) a. Functor f => f (Maybe a) -> a -> f a
Core..!@ forall a. Monoid a => a
Prelude.mempty)
            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
"templateId")
      )

instance Prelude.Hashable GetCase where
  hashWithSalt :: Int -> GetCase -> Int
hashWithSalt Int
_salt GetCase' {Maybe Text
NonEmpty FieldIdentifier
Text
fields :: NonEmpty FieldIdentifier
domainId :: Text
caseId :: Text
nextToken :: Maybe Text
$sel:fields:GetCase' :: GetCase -> NonEmpty FieldIdentifier
$sel:domainId:GetCase' :: GetCase -> Text
$sel:caseId:GetCase' :: GetCase -> Text
$sel:nextToken:GetCase' :: GetCase -> Maybe Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
nextToken
      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` NonEmpty FieldIdentifier
fields

instance Prelude.NFData GetCase where
  rnf :: GetCase -> ()
rnf GetCase' {Maybe Text
NonEmpty FieldIdentifier
Text
fields :: NonEmpty FieldIdentifier
domainId :: Text
caseId :: Text
nextToken :: Maybe Text
$sel:fields:GetCase' :: GetCase -> NonEmpty FieldIdentifier
$sel:domainId:GetCase' :: GetCase -> Text
$sel:caseId:GetCase' :: GetCase -> Text
$sel:nextToken:GetCase' :: GetCase -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
nextToken
      seq :: forall a b. a -> b -> b
`Prelude.seq` 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 NonEmpty FieldIdentifier
fields

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

instance Data.ToPath GetCase where
  toPath :: GetCase -> ByteString
toPath GetCase' {Maybe Text
NonEmpty FieldIdentifier
Text
fields :: NonEmpty FieldIdentifier
domainId :: Text
caseId :: Text
nextToken :: Maybe Text
$sel:fields:GetCase' :: GetCase -> NonEmpty FieldIdentifier
$sel:domainId:GetCase' :: GetCase -> Text
$sel:caseId:GetCase' :: GetCase -> Text
$sel:nextToken:GetCase' :: GetCase -> Maybe 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 GetCase where
  toQuery :: GetCase -> QueryString
toQuery = forall a b. a -> b -> a
Prelude.const forall a. Monoid a => a
Prelude.mempty

-- | /See:/ 'newGetCaseResponse' smart constructor.
data GetCaseResponse = GetCaseResponse'
  { -- | The token for the next set of results. This is null if there are no more
    -- results to return.
    GetCaseResponse -> Maybe Text
nextToken :: Prelude.Maybe Prelude.Text,
    -- | A map of of key-value pairs that represent tags on a resource. Tags are
    -- used to organize, track, or control access for this resource.
    GetCaseResponse -> Maybe (HashMap Text Text)
tags :: Prelude.Maybe (Prelude.HashMap Prelude.Text Prelude.Text),
    -- | The response's http status code.
    GetCaseResponse -> Int
httpStatus :: Prelude.Int,
    -- | A list of detailed field information.
    GetCaseResponse -> [FieldValue]
fields :: [FieldValue],
    -- | A unique identifier of a template.
    GetCaseResponse -> Text
templateId :: Prelude.Text
  }
  deriving (GetCaseResponse -> GetCaseResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetCaseResponse -> GetCaseResponse -> Bool
$c/= :: GetCaseResponse -> GetCaseResponse -> Bool
== :: GetCaseResponse -> GetCaseResponse -> Bool
$c== :: GetCaseResponse -> GetCaseResponse -> Bool
Prelude.Eq, ReadPrec [GetCaseResponse]
ReadPrec GetCaseResponse
Int -> ReadS GetCaseResponse
ReadS [GetCaseResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GetCaseResponse]
$creadListPrec :: ReadPrec [GetCaseResponse]
readPrec :: ReadPrec GetCaseResponse
$creadPrec :: ReadPrec GetCaseResponse
readList :: ReadS [GetCaseResponse]
$creadList :: ReadS [GetCaseResponse]
readsPrec :: Int -> ReadS GetCaseResponse
$creadsPrec :: Int -> ReadS GetCaseResponse
Prelude.Read, Int -> GetCaseResponse -> ShowS
[GetCaseResponse] -> ShowS
GetCaseResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetCaseResponse] -> ShowS
$cshowList :: [GetCaseResponse] -> ShowS
show :: GetCaseResponse -> String
$cshow :: GetCaseResponse -> String
showsPrec :: Int -> GetCaseResponse -> ShowS
$cshowsPrec :: Int -> GetCaseResponse -> ShowS
Prelude.Show, forall x. Rep GetCaseResponse x -> GetCaseResponse
forall x. GetCaseResponse -> Rep GetCaseResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep GetCaseResponse x -> GetCaseResponse
$cfrom :: forall x. GetCaseResponse -> Rep GetCaseResponse x
Prelude.Generic)

-- |
-- Create a value of 'GetCaseResponse' 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:
--
-- 'nextToken', 'getCaseResponse_nextToken' - The token for the next set of results. This is null if there are no more
-- results to return.
--
-- 'tags', 'getCaseResponse_tags' - A map of of key-value pairs that represent tags on a resource. Tags are
-- used to organize, track, or control access for this resource.
--
-- 'httpStatus', 'getCaseResponse_httpStatus' - The response's http status code.
--
-- 'fields', 'getCaseResponse_fields' - A list of detailed field information.
--
-- 'templateId', 'getCaseResponse_templateId' - A unique identifier of a template.
newGetCaseResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  -- | 'templateId'
  Prelude.Text ->
  GetCaseResponse
newGetCaseResponse :: Int -> Text -> GetCaseResponse
newGetCaseResponse Int
pHttpStatus_ Text
pTemplateId_ =
  GetCaseResponse'
    { $sel:nextToken:GetCaseResponse' :: Maybe Text
nextToken = forall a. Maybe a
Prelude.Nothing,
      $sel:tags:GetCaseResponse' :: Maybe (HashMap Text Text)
tags = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:GetCaseResponse' :: Int
httpStatus = Int
pHttpStatus_,
      $sel:fields:GetCaseResponse' :: [FieldValue]
fields = forall a. Monoid a => a
Prelude.mempty,
      $sel:templateId:GetCaseResponse' :: Text
templateId = Text
pTemplateId_
    }

-- | The token for the next set of results. This is null if there are no more
-- results to return.
getCaseResponse_nextToken :: Lens.Lens' GetCaseResponse (Prelude.Maybe Prelude.Text)
getCaseResponse_nextToken :: Lens' GetCaseResponse (Maybe Text)
getCaseResponse_nextToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetCaseResponse' {Maybe Text
nextToken :: Maybe Text
$sel:nextToken:GetCaseResponse' :: GetCaseResponse -> Maybe Text
nextToken} -> Maybe Text
nextToken) (\s :: GetCaseResponse
s@GetCaseResponse' {} Maybe Text
a -> GetCaseResponse
s {$sel:nextToken:GetCaseResponse' :: Maybe Text
nextToken = Maybe Text
a} :: GetCaseResponse)

-- | A map of of key-value pairs that represent tags on a resource. Tags are
-- used to organize, track, or control access for this resource.
getCaseResponse_tags :: Lens.Lens' GetCaseResponse (Prelude.Maybe (Prelude.HashMap Prelude.Text Prelude.Text))
getCaseResponse_tags :: Lens' GetCaseResponse (Maybe (HashMap Text Text))
getCaseResponse_tags = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetCaseResponse' {Maybe (HashMap Text Text)
tags :: Maybe (HashMap Text Text)
$sel:tags:GetCaseResponse' :: GetCaseResponse -> Maybe (HashMap Text Text)
tags} -> Maybe (HashMap Text Text)
tags) (\s :: GetCaseResponse
s@GetCaseResponse' {} Maybe (HashMap Text Text)
a -> GetCaseResponse
s {$sel:tags:GetCaseResponse' :: Maybe (HashMap Text Text)
tags = Maybe (HashMap Text Text)
a} :: GetCaseResponse) 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 response's http status code.
getCaseResponse_httpStatus :: Lens.Lens' GetCaseResponse Prelude.Int
getCaseResponse_httpStatus :: Lens' GetCaseResponse Int
getCaseResponse_httpStatus = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetCaseResponse' {Int
httpStatus :: Int
$sel:httpStatus:GetCaseResponse' :: GetCaseResponse -> Int
httpStatus} -> Int
httpStatus) (\s :: GetCaseResponse
s@GetCaseResponse' {} Int
a -> GetCaseResponse
s {$sel:httpStatus:GetCaseResponse' :: Int
httpStatus = Int
a} :: GetCaseResponse)

-- | A list of detailed field information.
getCaseResponse_fields :: Lens.Lens' GetCaseResponse [FieldValue]
getCaseResponse_fields :: Lens' GetCaseResponse [FieldValue]
getCaseResponse_fields = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetCaseResponse' {[FieldValue]
fields :: [FieldValue]
$sel:fields:GetCaseResponse' :: GetCaseResponse -> [FieldValue]
fields} -> [FieldValue]
fields) (\s :: GetCaseResponse
s@GetCaseResponse' {} [FieldValue]
a -> GetCaseResponse
s {$sel:fields:GetCaseResponse' :: [FieldValue]
fields = [FieldValue]
a} :: GetCaseResponse) 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.
getCaseResponse_templateId :: Lens.Lens' GetCaseResponse Prelude.Text
getCaseResponse_templateId :: Lens' GetCaseResponse Text
getCaseResponse_templateId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetCaseResponse' {Text
templateId :: Text
$sel:templateId:GetCaseResponse' :: GetCaseResponse -> Text
templateId} -> Text
templateId) (\s :: GetCaseResponse
s@GetCaseResponse' {} Text
a -> GetCaseResponse
s {$sel:templateId:GetCaseResponse' :: Text
templateId = Text
a} :: GetCaseResponse)

instance Prelude.NFData GetCaseResponse where
  rnf :: GetCaseResponse -> ()
rnf GetCaseResponse' {Int
[FieldValue]
Maybe Text
Maybe (HashMap Text Text)
Text
templateId :: Text
fields :: [FieldValue]
httpStatus :: Int
tags :: Maybe (HashMap Text Text)
nextToken :: Maybe Text
$sel:templateId:GetCaseResponse' :: GetCaseResponse -> Text
$sel:fields:GetCaseResponse' :: GetCaseResponse -> [FieldValue]
$sel:httpStatus:GetCaseResponse' :: GetCaseResponse -> Int
$sel:tags:GetCaseResponse' :: GetCaseResponse -> Maybe (HashMap Text Text)
$sel:nextToken:GetCaseResponse' :: GetCaseResponse -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
nextToken
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe (HashMap Text Text)
tags
      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 [FieldValue]
fields
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
templateId