{-# 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.UpdateTemplate
-- 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 attributes of an existing template. The template attributes
-- that can be modified include @name@, @description@,
-- @layoutConfiguration@, @requiredFields@, and @status@. At least one of
-- these attributes must not be null. If a null value is provided for a
-- given attribute, that attribute is ignored and its current value is
-- preserved.
module Amazonka.ConnectCases.UpdateTemplate
  ( -- * Creating a Request
    UpdateTemplate (..),
    newUpdateTemplate,

    -- * Request Lenses
    updateTemplate_description,
    updateTemplate_layoutConfiguration,
    updateTemplate_name,
    updateTemplate_requiredFields,
    updateTemplate_status,
    updateTemplate_domainId,
    updateTemplate_templateId,

    -- * Destructuring the Response
    UpdateTemplateResponse (..),
    newUpdateTemplateResponse,

    -- * Response Lenses
    updateTemplateResponse_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:/ 'newUpdateTemplate' smart constructor.
data UpdateTemplate = UpdateTemplate'
  { -- | A brief description of the template.
    UpdateTemplate -> Maybe Text
description :: Prelude.Maybe Prelude.Text,
    -- | Configuration of layouts associated to the template.
    UpdateTemplate -> Maybe LayoutConfiguration
layoutConfiguration :: Prelude.Maybe LayoutConfiguration,
    -- | The name of the template. It must be unique per domain.
    UpdateTemplate -> Maybe Text
name :: Prelude.Maybe Prelude.Text,
    -- | A list of fields that must contain a value for a case to be successfully
    -- created with this template.
    UpdateTemplate -> Maybe [RequiredField]
requiredFields :: Prelude.Maybe [RequiredField],
    -- | The status of the template.
    UpdateTemplate -> Maybe TemplateStatus
status :: Prelude.Maybe TemplateStatus,
    -- | The unique identifier of the Cases domain.
    UpdateTemplate -> Text
domainId :: Prelude.Text,
    -- | A unique identifier for the template.
    UpdateTemplate -> Text
templateId :: Prelude.Text
  }
  deriving (UpdateTemplate -> UpdateTemplate -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UpdateTemplate -> UpdateTemplate -> Bool
$c/= :: UpdateTemplate -> UpdateTemplate -> Bool
== :: UpdateTemplate -> UpdateTemplate -> Bool
$c== :: UpdateTemplate -> UpdateTemplate -> Bool
Prelude.Eq, ReadPrec [UpdateTemplate]
ReadPrec UpdateTemplate
Int -> ReadS UpdateTemplate
ReadS [UpdateTemplate]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [UpdateTemplate]
$creadListPrec :: ReadPrec [UpdateTemplate]
readPrec :: ReadPrec UpdateTemplate
$creadPrec :: ReadPrec UpdateTemplate
readList :: ReadS [UpdateTemplate]
$creadList :: ReadS [UpdateTemplate]
readsPrec :: Int -> ReadS UpdateTemplate
$creadsPrec :: Int -> ReadS UpdateTemplate
Prelude.Read, Int -> UpdateTemplate -> ShowS
[UpdateTemplate] -> ShowS
UpdateTemplate -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UpdateTemplate] -> ShowS
$cshowList :: [UpdateTemplate] -> ShowS
show :: UpdateTemplate -> String
$cshow :: UpdateTemplate -> String
showsPrec :: Int -> UpdateTemplate -> ShowS
$cshowsPrec :: Int -> UpdateTemplate -> ShowS
Prelude.Show, forall x. Rep UpdateTemplate x -> UpdateTemplate
forall x. UpdateTemplate -> Rep UpdateTemplate x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep UpdateTemplate x -> UpdateTemplate
$cfrom :: forall x. UpdateTemplate -> Rep UpdateTemplate x
Prelude.Generic)

-- |
-- Create a value of 'UpdateTemplate' 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:
--
-- 'description', 'updateTemplate_description' - A brief description of the template.
--
-- 'layoutConfiguration', 'updateTemplate_layoutConfiguration' - Configuration of layouts associated to the template.
--
-- 'name', 'updateTemplate_name' - The name of the template. It must be unique per domain.
--
-- 'requiredFields', 'updateTemplate_requiredFields' - A list of fields that must contain a value for a case to be successfully
-- created with this template.
--
-- 'status', 'updateTemplate_status' - The status of the template.
--
-- 'domainId', 'updateTemplate_domainId' - The unique identifier of the Cases domain.
--
-- 'templateId', 'updateTemplate_templateId' - A unique identifier for the template.
newUpdateTemplate ::
  -- | 'domainId'
  Prelude.Text ->
  -- | 'templateId'
  Prelude.Text ->
  UpdateTemplate
newUpdateTemplate :: Text -> Text -> UpdateTemplate
newUpdateTemplate Text
pDomainId_ Text
pTemplateId_ =
  UpdateTemplate'
    { $sel:description:UpdateTemplate' :: Maybe Text
description = forall a. Maybe a
Prelude.Nothing,
      $sel:layoutConfiguration:UpdateTemplate' :: Maybe LayoutConfiguration
layoutConfiguration = forall a. Maybe a
Prelude.Nothing,
      $sel:name:UpdateTemplate' :: Maybe Text
name = forall a. Maybe a
Prelude.Nothing,
      $sel:requiredFields:UpdateTemplate' :: Maybe [RequiredField]
requiredFields = forall a. Maybe a
Prelude.Nothing,
      $sel:status:UpdateTemplate' :: Maybe TemplateStatus
status = forall a. Maybe a
Prelude.Nothing,
      $sel:domainId:UpdateTemplate' :: Text
domainId = Text
pDomainId_,
      $sel:templateId:UpdateTemplate' :: Text
templateId = Text
pTemplateId_
    }

-- | A brief description of the template.
updateTemplate_description :: Lens.Lens' UpdateTemplate (Prelude.Maybe Prelude.Text)
updateTemplate_description :: Lens' UpdateTemplate (Maybe Text)
updateTemplate_description = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateTemplate' {Maybe Text
description :: Maybe Text
$sel:description:UpdateTemplate' :: UpdateTemplate -> Maybe Text
description} -> Maybe Text
description) (\s :: UpdateTemplate
s@UpdateTemplate' {} Maybe Text
a -> UpdateTemplate
s {$sel:description:UpdateTemplate' :: Maybe Text
description = Maybe Text
a} :: UpdateTemplate)

-- | Configuration of layouts associated to the template.
updateTemplate_layoutConfiguration :: Lens.Lens' UpdateTemplate (Prelude.Maybe LayoutConfiguration)
updateTemplate_layoutConfiguration :: Lens' UpdateTemplate (Maybe LayoutConfiguration)
updateTemplate_layoutConfiguration = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateTemplate' {Maybe LayoutConfiguration
layoutConfiguration :: Maybe LayoutConfiguration
$sel:layoutConfiguration:UpdateTemplate' :: UpdateTemplate -> Maybe LayoutConfiguration
layoutConfiguration} -> Maybe LayoutConfiguration
layoutConfiguration) (\s :: UpdateTemplate
s@UpdateTemplate' {} Maybe LayoutConfiguration
a -> UpdateTemplate
s {$sel:layoutConfiguration:UpdateTemplate' :: Maybe LayoutConfiguration
layoutConfiguration = Maybe LayoutConfiguration
a} :: UpdateTemplate)

-- | The name of the template. It must be unique per domain.
updateTemplate_name :: Lens.Lens' UpdateTemplate (Prelude.Maybe Prelude.Text)
updateTemplate_name :: Lens' UpdateTemplate (Maybe Text)
updateTemplate_name = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateTemplate' {Maybe Text
name :: Maybe Text
$sel:name:UpdateTemplate' :: UpdateTemplate -> Maybe Text
name} -> Maybe Text
name) (\s :: UpdateTemplate
s@UpdateTemplate' {} Maybe Text
a -> UpdateTemplate
s {$sel:name:UpdateTemplate' :: Maybe Text
name = Maybe Text
a} :: UpdateTemplate)

-- | A list of fields that must contain a value for a case to be successfully
-- created with this template.
updateTemplate_requiredFields :: Lens.Lens' UpdateTemplate (Prelude.Maybe [RequiredField])
updateTemplate_requiredFields :: Lens' UpdateTemplate (Maybe [RequiredField])
updateTemplate_requiredFields = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateTemplate' {Maybe [RequiredField]
requiredFields :: Maybe [RequiredField]
$sel:requiredFields:UpdateTemplate' :: UpdateTemplate -> Maybe [RequiredField]
requiredFields} -> Maybe [RequiredField]
requiredFields) (\s :: UpdateTemplate
s@UpdateTemplate' {} Maybe [RequiredField]
a -> UpdateTemplate
s {$sel:requiredFields:UpdateTemplate' :: Maybe [RequiredField]
requiredFields = Maybe [RequiredField]
a} :: UpdateTemplate) 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 status of the template.
updateTemplate_status :: Lens.Lens' UpdateTemplate (Prelude.Maybe TemplateStatus)
updateTemplate_status :: Lens' UpdateTemplate (Maybe TemplateStatus)
updateTemplate_status = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateTemplate' {Maybe TemplateStatus
status :: Maybe TemplateStatus
$sel:status:UpdateTemplate' :: UpdateTemplate -> Maybe TemplateStatus
status} -> Maybe TemplateStatus
status) (\s :: UpdateTemplate
s@UpdateTemplate' {} Maybe TemplateStatus
a -> UpdateTemplate
s {$sel:status:UpdateTemplate' :: Maybe TemplateStatus
status = Maybe TemplateStatus
a} :: UpdateTemplate)

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

-- | A unique identifier for the template.
updateTemplate_templateId :: Lens.Lens' UpdateTemplate Prelude.Text
updateTemplate_templateId :: Lens' UpdateTemplate Text
updateTemplate_templateId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateTemplate' {Text
templateId :: Text
$sel:templateId:UpdateTemplate' :: UpdateTemplate -> Text
templateId} -> Text
templateId) (\s :: UpdateTemplate
s@UpdateTemplate' {} Text
a -> UpdateTemplate
s {$sel:templateId:UpdateTemplate' :: Text
templateId = Text
a} :: UpdateTemplate)

instance Core.AWSRequest UpdateTemplate where
  type
    AWSResponse UpdateTemplate =
      UpdateTemplateResponse
  request :: (Service -> Service) -> UpdateTemplate -> Request UpdateTemplate
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 UpdateTemplate
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse UpdateTemplate)))
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 -> UpdateTemplateResponse
UpdateTemplateResponse'
            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 UpdateTemplate where
  hashWithSalt :: Int -> UpdateTemplate -> Int
hashWithSalt Int
_salt UpdateTemplate' {Maybe [RequiredField]
Maybe Text
Maybe LayoutConfiguration
Maybe TemplateStatus
Text
templateId :: Text
domainId :: Text
status :: Maybe TemplateStatus
requiredFields :: Maybe [RequiredField]
name :: Maybe Text
layoutConfiguration :: Maybe LayoutConfiguration
description :: Maybe Text
$sel:templateId:UpdateTemplate' :: UpdateTemplate -> Text
$sel:domainId:UpdateTemplate' :: UpdateTemplate -> Text
$sel:status:UpdateTemplate' :: UpdateTemplate -> Maybe TemplateStatus
$sel:requiredFields:UpdateTemplate' :: UpdateTemplate -> Maybe [RequiredField]
$sel:name:UpdateTemplate' :: UpdateTemplate -> Maybe Text
$sel:layoutConfiguration:UpdateTemplate' :: UpdateTemplate -> Maybe LayoutConfiguration
$sel:description:UpdateTemplate' :: UpdateTemplate -> Maybe Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
description
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe LayoutConfiguration
layoutConfiguration
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
name
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [RequiredField]
requiredFields
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe TemplateStatus
status
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
domainId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
templateId

instance Prelude.NFData UpdateTemplate where
  rnf :: UpdateTemplate -> ()
rnf UpdateTemplate' {Maybe [RequiredField]
Maybe Text
Maybe LayoutConfiguration
Maybe TemplateStatus
Text
templateId :: Text
domainId :: Text
status :: Maybe TemplateStatus
requiredFields :: Maybe [RequiredField]
name :: Maybe Text
layoutConfiguration :: Maybe LayoutConfiguration
description :: Maybe Text
$sel:templateId:UpdateTemplate' :: UpdateTemplate -> Text
$sel:domainId:UpdateTemplate' :: UpdateTemplate -> Text
$sel:status:UpdateTemplate' :: UpdateTemplate -> Maybe TemplateStatus
$sel:requiredFields:UpdateTemplate' :: UpdateTemplate -> Maybe [RequiredField]
$sel:name:UpdateTemplate' :: UpdateTemplate -> Maybe Text
$sel:layoutConfiguration:UpdateTemplate' :: UpdateTemplate -> Maybe LayoutConfiguration
$sel:description:UpdateTemplate' :: UpdateTemplate -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
description
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe LayoutConfiguration
layoutConfiguration
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
name
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [RequiredField]
requiredFields
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe TemplateStatus
status
      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 Text
templateId

instance Data.ToHeaders UpdateTemplate where
  toHeaders :: UpdateTemplate -> 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 UpdateTemplate where
  toJSON :: UpdateTemplate -> Value
toJSON UpdateTemplate' {Maybe [RequiredField]
Maybe Text
Maybe LayoutConfiguration
Maybe TemplateStatus
Text
templateId :: Text
domainId :: Text
status :: Maybe TemplateStatus
requiredFields :: Maybe [RequiredField]
name :: Maybe Text
layoutConfiguration :: Maybe LayoutConfiguration
description :: Maybe Text
$sel:templateId:UpdateTemplate' :: UpdateTemplate -> Text
$sel:domainId:UpdateTemplate' :: UpdateTemplate -> Text
$sel:status:UpdateTemplate' :: UpdateTemplate -> Maybe TemplateStatus
$sel:requiredFields:UpdateTemplate' :: UpdateTemplate -> Maybe [RequiredField]
$sel:name:UpdateTemplate' :: UpdateTemplate -> Maybe Text
$sel:layoutConfiguration:UpdateTemplate' :: UpdateTemplate -> Maybe LayoutConfiguration
$sel:description:UpdateTemplate' :: UpdateTemplate -> Maybe Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"description" 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
description,
            (Key
"layoutConfiguration" 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 LayoutConfiguration
layoutConfiguration,
            (Key
"name" 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
name,
            (Key
"requiredFields" 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 [RequiredField]
requiredFields,
            (Key
"status" 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 TemplateStatus
status
          ]
      )

instance Data.ToPath UpdateTemplate where
  toPath :: UpdateTemplate -> ByteString
toPath UpdateTemplate' {Maybe [RequiredField]
Maybe Text
Maybe LayoutConfiguration
Maybe TemplateStatus
Text
templateId :: Text
domainId :: Text
status :: Maybe TemplateStatus
requiredFields :: Maybe [RequiredField]
name :: Maybe Text
layoutConfiguration :: Maybe LayoutConfiguration
description :: Maybe Text
$sel:templateId:UpdateTemplate' :: UpdateTemplate -> Text
$sel:domainId:UpdateTemplate' :: UpdateTemplate -> Text
$sel:status:UpdateTemplate' :: UpdateTemplate -> Maybe TemplateStatus
$sel:requiredFields:UpdateTemplate' :: UpdateTemplate -> Maybe [RequiredField]
$sel:name:UpdateTemplate' :: UpdateTemplate -> Maybe Text
$sel:layoutConfiguration:UpdateTemplate' :: UpdateTemplate -> Maybe LayoutConfiguration
$sel:description:UpdateTemplate' :: UpdateTemplate -> Maybe Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"/domains/",
        forall a. ToByteString a => a -> ByteString
Data.toBS Text
domainId,
        ByteString
"/templates/",
        forall a. ToByteString a => a -> ByteString
Data.toBS Text
templateId
      ]

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

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

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

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

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