{-# 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.Proton.UpdateServiceTemplate
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Update a service template.
module Amazonka.Proton.UpdateServiceTemplate
  ( -- * Creating a Request
    UpdateServiceTemplate (..),
    newUpdateServiceTemplate,

    -- * Request Lenses
    updateServiceTemplate_description,
    updateServiceTemplate_displayName,
    updateServiceTemplate_name,

    -- * Destructuring the Response
    UpdateServiceTemplateResponse (..),
    newUpdateServiceTemplateResponse,

    -- * Response Lenses
    updateServiceTemplateResponse_httpStatus,
    updateServiceTemplateResponse_serviceTemplate,
  )
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 Amazonka.Proton.Types
import qualified Amazonka.Request as Request
import qualified Amazonka.Response as Response

-- | /See:/ 'newUpdateServiceTemplate' smart constructor.
data UpdateServiceTemplate = UpdateServiceTemplate'
  { -- | A description of the service template update.
    UpdateServiceTemplate -> Maybe (Sensitive Text)
description :: Prelude.Maybe (Data.Sensitive Prelude.Text),
    -- | The name of the service template to update that\'s displayed in the
    -- developer interface.
    UpdateServiceTemplate -> Maybe (Sensitive Text)
displayName :: Prelude.Maybe (Data.Sensitive Prelude.Text),
    -- | The name of the service template to update.
    UpdateServiceTemplate -> Text
name :: Prelude.Text
  }
  deriving (UpdateServiceTemplate -> UpdateServiceTemplate -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UpdateServiceTemplate -> UpdateServiceTemplate -> Bool
$c/= :: UpdateServiceTemplate -> UpdateServiceTemplate -> Bool
== :: UpdateServiceTemplate -> UpdateServiceTemplate -> Bool
$c== :: UpdateServiceTemplate -> UpdateServiceTemplate -> Bool
Prelude.Eq, Int -> UpdateServiceTemplate -> ShowS
[UpdateServiceTemplate] -> ShowS
UpdateServiceTemplate -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UpdateServiceTemplate] -> ShowS
$cshowList :: [UpdateServiceTemplate] -> ShowS
show :: UpdateServiceTemplate -> String
$cshow :: UpdateServiceTemplate -> String
showsPrec :: Int -> UpdateServiceTemplate -> ShowS
$cshowsPrec :: Int -> UpdateServiceTemplate -> ShowS
Prelude.Show, forall x. Rep UpdateServiceTemplate x -> UpdateServiceTemplate
forall x. UpdateServiceTemplate -> Rep UpdateServiceTemplate x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep UpdateServiceTemplate x -> UpdateServiceTemplate
$cfrom :: forall x. UpdateServiceTemplate -> Rep UpdateServiceTemplate x
Prelude.Generic)

-- |
-- Create a value of 'UpdateServiceTemplate' 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', 'updateServiceTemplate_description' - A description of the service template update.
--
-- 'displayName', 'updateServiceTemplate_displayName' - The name of the service template to update that\'s displayed in the
-- developer interface.
--
-- 'name', 'updateServiceTemplate_name' - The name of the service template to update.
newUpdateServiceTemplate ::
  -- | 'name'
  Prelude.Text ->
  UpdateServiceTemplate
newUpdateServiceTemplate :: Text -> UpdateServiceTemplate
newUpdateServiceTemplate Text
pName_ =
  UpdateServiceTemplate'
    { $sel:description:UpdateServiceTemplate' :: Maybe (Sensitive Text)
description =
        forall a. Maybe a
Prelude.Nothing,
      $sel:displayName:UpdateServiceTemplate' :: Maybe (Sensitive Text)
displayName = forall a. Maybe a
Prelude.Nothing,
      $sel:name:UpdateServiceTemplate' :: Text
name = Text
pName_
    }

-- | A description of the service template update.
updateServiceTemplate_description :: Lens.Lens' UpdateServiceTemplate (Prelude.Maybe Prelude.Text)
updateServiceTemplate_description :: Lens' UpdateServiceTemplate (Maybe Text)
updateServiceTemplate_description = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateServiceTemplate' {Maybe (Sensitive Text)
description :: Maybe (Sensitive Text)
$sel:description:UpdateServiceTemplate' :: UpdateServiceTemplate -> Maybe (Sensitive Text)
description} -> Maybe (Sensitive Text)
description) (\s :: UpdateServiceTemplate
s@UpdateServiceTemplate' {} Maybe (Sensitive Text)
a -> UpdateServiceTemplate
s {$sel:description:UpdateServiceTemplate' :: Maybe (Sensitive Text)
description = Maybe (Sensitive Text)
a} :: UpdateServiceTemplate) 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 a. Iso' (Sensitive a) a
Data._Sensitive

-- | The name of the service template to update that\'s displayed in the
-- developer interface.
updateServiceTemplate_displayName :: Lens.Lens' UpdateServiceTemplate (Prelude.Maybe Prelude.Text)
updateServiceTemplate_displayName :: Lens' UpdateServiceTemplate (Maybe Text)
updateServiceTemplate_displayName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateServiceTemplate' {Maybe (Sensitive Text)
displayName :: Maybe (Sensitive Text)
$sel:displayName:UpdateServiceTemplate' :: UpdateServiceTemplate -> Maybe (Sensitive Text)
displayName} -> Maybe (Sensitive Text)
displayName) (\s :: UpdateServiceTemplate
s@UpdateServiceTemplate' {} Maybe (Sensitive Text)
a -> UpdateServiceTemplate
s {$sel:displayName:UpdateServiceTemplate' :: Maybe (Sensitive Text)
displayName = Maybe (Sensitive Text)
a} :: UpdateServiceTemplate) 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 a. Iso' (Sensitive a) a
Data._Sensitive

-- | The name of the service template to update.
updateServiceTemplate_name :: Lens.Lens' UpdateServiceTemplate Prelude.Text
updateServiceTemplate_name :: Lens' UpdateServiceTemplate Text
updateServiceTemplate_name = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateServiceTemplate' {Text
name :: Text
$sel:name:UpdateServiceTemplate' :: UpdateServiceTemplate -> Text
name} -> Text
name) (\s :: UpdateServiceTemplate
s@UpdateServiceTemplate' {} Text
a -> UpdateServiceTemplate
s {$sel:name:UpdateServiceTemplate' :: Text
name = Text
a} :: UpdateServiceTemplate)

instance Core.AWSRequest UpdateServiceTemplate where
  type
    AWSResponse UpdateServiceTemplate =
      UpdateServiceTemplateResponse
  request :: (Service -> Service)
-> UpdateServiceTemplate -> Request UpdateServiceTemplate
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 UpdateServiceTemplate
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse UpdateServiceTemplate)))
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 -> ServiceTemplate -> UpdateServiceTemplateResponse
UpdateServiceTemplateResponse'
            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
"serviceTemplate")
      )

instance Prelude.Hashable UpdateServiceTemplate where
  hashWithSalt :: Int -> UpdateServiceTemplate -> Int
hashWithSalt Int
_salt UpdateServiceTemplate' {Maybe (Sensitive Text)
Text
name :: Text
displayName :: Maybe (Sensitive Text)
description :: Maybe (Sensitive Text)
$sel:name:UpdateServiceTemplate' :: UpdateServiceTemplate -> Text
$sel:displayName:UpdateServiceTemplate' :: UpdateServiceTemplate -> Maybe (Sensitive Text)
$sel:description:UpdateServiceTemplate' :: UpdateServiceTemplate -> Maybe (Sensitive Text)
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe (Sensitive Text)
description
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe (Sensitive Text)
displayName
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
name

instance Prelude.NFData UpdateServiceTemplate where
  rnf :: UpdateServiceTemplate -> ()
rnf UpdateServiceTemplate' {Maybe (Sensitive Text)
Text
name :: Text
displayName :: Maybe (Sensitive Text)
description :: Maybe (Sensitive Text)
$sel:name:UpdateServiceTemplate' :: UpdateServiceTemplate -> Text
$sel:displayName:UpdateServiceTemplate' :: UpdateServiceTemplate -> Maybe (Sensitive Text)
$sel:description:UpdateServiceTemplate' :: UpdateServiceTemplate -> Maybe (Sensitive Text)
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe (Sensitive Text)
description
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe (Sensitive Text)
displayName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
name

instance Data.ToHeaders UpdateServiceTemplate where
  toHeaders :: UpdateServiceTemplate -> 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
"AwsProton20200720.UpdateServiceTemplate" ::
                          Prelude.ByteString
                      ),
            HeaderName
"Content-Type"
              forall a. ToHeader a => HeaderName -> a -> ResponseHeaders
Data.=# ( ByteString
"application/x-amz-json-1.0" ::
                          Prelude.ByteString
                      )
          ]
      )

instance Data.ToJSON UpdateServiceTemplate where
  toJSON :: UpdateServiceTemplate -> Value
toJSON UpdateServiceTemplate' {Maybe (Sensitive Text)
Text
name :: Text
displayName :: Maybe (Sensitive Text)
description :: Maybe (Sensitive Text)
$sel:name:UpdateServiceTemplate' :: UpdateServiceTemplate -> Text
$sel:displayName:UpdateServiceTemplate' :: UpdateServiceTemplate -> Maybe (Sensitive Text)
$sel:description:UpdateServiceTemplate' :: UpdateServiceTemplate -> Maybe (Sensitive 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 (Sensitive Text)
description,
            (Key
"displayName" 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 (Sensitive Text)
displayName,
            forall a. a -> Maybe a
Prelude.Just (Key
"name" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
name)
          ]
      )

instance Data.ToPath UpdateServiceTemplate where
  toPath :: UpdateServiceTemplate -> ByteString
toPath = forall a b. a -> b -> a
Prelude.const ByteString
"/"

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

-- | /See:/ 'newUpdateServiceTemplateResponse' smart constructor.
data UpdateServiceTemplateResponse = UpdateServiceTemplateResponse'
  { -- | The response's http status code.
    UpdateServiceTemplateResponse -> Int
httpStatus :: Prelude.Int,
    -- | The service template detail data that\'s returned by Proton.
    UpdateServiceTemplateResponse -> ServiceTemplate
serviceTemplate :: ServiceTemplate
  }
  deriving (UpdateServiceTemplateResponse
-> UpdateServiceTemplateResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UpdateServiceTemplateResponse
-> UpdateServiceTemplateResponse -> Bool
$c/= :: UpdateServiceTemplateResponse
-> UpdateServiceTemplateResponse -> Bool
== :: UpdateServiceTemplateResponse
-> UpdateServiceTemplateResponse -> Bool
$c== :: UpdateServiceTemplateResponse
-> UpdateServiceTemplateResponse -> Bool
Prelude.Eq, Int -> UpdateServiceTemplateResponse -> ShowS
[UpdateServiceTemplateResponse] -> ShowS
UpdateServiceTemplateResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UpdateServiceTemplateResponse] -> ShowS
$cshowList :: [UpdateServiceTemplateResponse] -> ShowS
show :: UpdateServiceTemplateResponse -> String
$cshow :: UpdateServiceTemplateResponse -> String
showsPrec :: Int -> UpdateServiceTemplateResponse -> ShowS
$cshowsPrec :: Int -> UpdateServiceTemplateResponse -> ShowS
Prelude.Show, forall x.
Rep UpdateServiceTemplateResponse x
-> UpdateServiceTemplateResponse
forall x.
UpdateServiceTemplateResponse
-> Rep UpdateServiceTemplateResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep UpdateServiceTemplateResponse x
-> UpdateServiceTemplateResponse
$cfrom :: forall x.
UpdateServiceTemplateResponse
-> Rep UpdateServiceTemplateResponse x
Prelude.Generic)

-- |
-- Create a value of 'UpdateServiceTemplateResponse' 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', 'updateServiceTemplateResponse_httpStatus' - The response's http status code.
--
-- 'serviceTemplate', 'updateServiceTemplateResponse_serviceTemplate' - The service template detail data that\'s returned by Proton.
newUpdateServiceTemplateResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  -- | 'serviceTemplate'
  ServiceTemplate ->
  UpdateServiceTemplateResponse
newUpdateServiceTemplateResponse :: Int -> ServiceTemplate -> UpdateServiceTemplateResponse
newUpdateServiceTemplateResponse
  Int
pHttpStatus_
  ServiceTemplate
pServiceTemplate_ =
    UpdateServiceTemplateResponse'
      { $sel:httpStatus:UpdateServiceTemplateResponse' :: Int
httpStatus =
          Int
pHttpStatus_,
        $sel:serviceTemplate:UpdateServiceTemplateResponse' :: ServiceTemplate
serviceTemplate = ServiceTemplate
pServiceTemplate_
      }

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

-- | The service template detail data that\'s returned by Proton.
updateServiceTemplateResponse_serviceTemplate :: Lens.Lens' UpdateServiceTemplateResponse ServiceTemplate
updateServiceTemplateResponse_serviceTemplate :: Lens' UpdateServiceTemplateResponse ServiceTemplate
updateServiceTemplateResponse_serviceTemplate = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateServiceTemplateResponse' {ServiceTemplate
serviceTemplate :: ServiceTemplate
$sel:serviceTemplate:UpdateServiceTemplateResponse' :: UpdateServiceTemplateResponse -> ServiceTemplate
serviceTemplate} -> ServiceTemplate
serviceTemplate) (\s :: UpdateServiceTemplateResponse
s@UpdateServiceTemplateResponse' {} ServiceTemplate
a -> UpdateServiceTemplateResponse
s {$sel:serviceTemplate:UpdateServiceTemplateResponse' :: ServiceTemplate
serviceTemplate = ServiceTemplate
a} :: UpdateServiceTemplateResponse)

instance Prelude.NFData UpdateServiceTemplateResponse where
  rnf :: UpdateServiceTemplateResponse -> ()
rnf UpdateServiceTemplateResponse' {Int
ServiceTemplate
serviceTemplate :: ServiceTemplate
httpStatus :: Int
$sel:serviceTemplate:UpdateServiceTemplateResponse' :: UpdateServiceTemplateResponse -> ServiceTemplate
$sel:httpStatus:UpdateServiceTemplateResponse' :: UpdateServiceTemplateResponse -> 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 ServiceTemplate
serviceTemplate