{-# 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.CreateEnvironmentTemplateVersion
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Create a new major or minor version of an environment template. A major
-- version of an environment template is a version that /isn\'t/ backwards
-- compatible. A minor version of an environment template is a version
-- that\'s backwards compatible within its major version.
module Amazonka.Proton.CreateEnvironmentTemplateVersion
  ( -- * Creating a Request
    CreateEnvironmentTemplateVersion (..),
    newCreateEnvironmentTemplateVersion,

    -- * Request Lenses
    createEnvironmentTemplateVersion_clientToken,
    createEnvironmentTemplateVersion_description,
    createEnvironmentTemplateVersion_majorVersion,
    createEnvironmentTemplateVersion_tags,
    createEnvironmentTemplateVersion_source,
    createEnvironmentTemplateVersion_templateName,

    -- * Destructuring the Response
    CreateEnvironmentTemplateVersionResponse (..),
    newCreateEnvironmentTemplateVersionResponse,

    -- * Response Lenses
    createEnvironmentTemplateVersionResponse_httpStatus,
    createEnvironmentTemplateVersionResponse_environmentTemplateVersion,
  )
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:/ 'newCreateEnvironmentTemplateVersion' smart constructor.
data CreateEnvironmentTemplateVersion = CreateEnvironmentTemplateVersion'
  { -- | When included, if two identical requests are made with the same client
    -- token, Proton returns the environment template version that the first
    -- request created.
    CreateEnvironmentTemplateVersion -> Maybe Text
clientToken :: Prelude.Maybe Prelude.Text,
    -- | A description of the new version of an environment template.
    CreateEnvironmentTemplateVersion -> Maybe (Sensitive Text)
description :: Prelude.Maybe (Data.Sensitive Prelude.Text),
    -- | To create a new minor version of the environment template, include
    -- @major Version@.
    --
    -- To create a new major and minor version of the environment template,
    -- exclude @major Version@.
    CreateEnvironmentTemplateVersion -> Maybe Text
majorVersion :: Prelude.Maybe Prelude.Text,
    -- | An optional list of metadata items that you can associate with the
    -- Proton environment template version. A tag is a key-value pair.
    --
    -- For more information, see
    -- <https://docs.aws.amazon.com/proton/latest/userguide/resources.html Proton resources and tagging>
    -- in the /Proton User Guide/.
    CreateEnvironmentTemplateVersion -> Maybe [Tag]
tags :: Prelude.Maybe [Tag],
    -- | An object that includes the template bundle S3 bucket path and name for
    -- the new version of an template.
    CreateEnvironmentTemplateVersion -> TemplateVersionSourceInput
source :: TemplateVersionSourceInput,
    -- | The name of the environment template.
    CreateEnvironmentTemplateVersion -> Text
templateName :: Prelude.Text
  }
  deriving (CreateEnvironmentTemplateVersion
-> CreateEnvironmentTemplateVersion -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateEnvironmentTemplateVersion
-> CreateEnvironmentTemplateVersion -> Bool
$c/= :: CreateEnvironmentTemplateVersion
-> CreateEnvironmentTemplateVersion -> Bool
== :: CreateEnvironmentTemplateVersion
-> CreateEnvironmentTemplateVersion -> Bool
$c== :: CreateEnvironmentTemplateVersion
-> CreateEnvironmentTemplateVersion -> Bool
Prelude.Eq, Int -> CreateEnvironmentTemplateVersion -> ShowS
[CreateEnvironmentTemplateVersion] -> ShowS
CreateEnvironmentTemplateVersion -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateEnvironmentTemplateVersion] -> ShowS
$cshowList :: [CreateEnvironmentTemplateVersion] -> ShowS
show :: CreateEnvironmentTemplateVersion -> String
$cshow :: CreateEnvironmentTemplateVersion -> String
showsPrec :: Int -> CreateEnvironmentTemplateVersion -> ShowS
$cshowsPrec :: Int -> CreateEnvironmentTemplateVersion -> ShowS
Prelude.Show, forall x.
Rep CreateEnvironmentTemplateVersion x
-> CreateEnvironmentTemplateVersion
forall x.
CreateEnvironmentTemplateVersion
-> Rep CreateEnvironmentTemplateVersion x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep CreateEnvironmentTemplateVersion x
-> CreateEnvironmentTemplateVersion
$cfrom :: forall x.
CreateEnvironmentTemplateVersion
-> Rep CreateEnvironmentTemplateVersion x
Prelude.Generic)

-- |
-- Create a value of 'CreateEnvironmentTemplateVersion' 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', 'createEnvironmentTemplateVersion_clientToken' - When included, if two identical requests are made with the same client
-- token, Proton returns the environment template version that the first
-- request created.
--
-- 'description', 'createEnvironmentTemplateVersion_description' - A description of the new version of an environment template.
--
-- 'majorVersion', 'createEnvironmentTemplateVersion_majorVersion' - To create a new minor version of the environment template, include
-- @major Version@.
--
-- To create a new major and minor version of the environment template,
-- exclude @major Version@.
--
-- 'tags', 'createEnvironmentTemplateVersion_tags' - An optional list of metadata items that you can associate with the
-- Proton environment template version. A tag is a key-value pair.
--
-- For more information, see
-- <https://docs.aws.amazon.com/proton/latest/userguide/resources.html Proton resources and tagging>
-- in the /Proton User Guide/.
--
-- 'source', 'createEnvironmentTemplateVersion_source' - An object that includes the template bundle S3 bucket path and name for
-- the new version of an template.
--
-- 'templateName', 'createEnvironmentTemplateVersion_templateName' - The name of the environment template.
newCreateEnvironmentTemplateVersion ::
  -- | 'source'
  TemplateVersionSourceInput ->
  -- | 'templateName'
  Prelude.Text ->
  CreateEnvironmentTemplateVersion
newCreateEnvironmentTemplateVersion :: TemplateVersionSourceInput
-> Text -> CreateEnvironmentTemplateVersion
newCreateEnvironmentTemplateVersion
  TemplateVersionSourceInput
pSource_
  Text
pTemplateName_ =
    CreateEnvironmentTemplateVersion'
      { $sel:clientToken:CreateEnvironmentTemplateVersion' :: Maybe Text
clientToken =
          forall a. Maybe a
Prelude.Nothing,
        $sel:description:CreateEnvironmentTemplateVersion' :: Maybe (Sensitive Text)
description = forall a. Maybe a
Prelude.Nothing,
        $sel:majorVersion:CreateEnvironmentTemplateVersion' :: Maybe Text
majorVersion = forall a. Maybe a
Prelude.Nothing,
        $sel:tags:CreateEnvironmentTemplateVersion' :: Maybe [Tag]
tags = forall a. Maybe a
Prelude.Nothing,
        $sel:source:CreateEnvironmentTemplateVersion' :: TemplateVersionSourceInput
source = TemplateVersionSourceInput
pSource_,
        $sel:templateName:CreateEnvironmentTemplateVersion' :: Text
templateName = Text
pTemplateName_
      }

-- | When included, if two identical requests are made with the same client
-- token, Proton returns the environment template version that the first
-- request created.
createEnvironmentTemplateVersion_clientToken :: Lens.Lens' CreateEnvironmentTemplateVersion (Prelude.Maybe Prelude.Text)
createEnvironmentTemplateVersion_clientToken :: Lens' CreateEnvironmentTemplateVersion (Maybe Text)
createEnvironmentTemplateVersion_clientToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateEnvironmentTemplateVersion' {Maybe Text
clientToken :: Maybe Text
$sel:clientToken:CreateEnvironmentTemplateVersion' :: CreateEnvironmentTemplateVersion -> Maybe Text
clientToken} -> Maybe Text
clientToken) (\s :: CreateEnvironmentTemplateVersion
s@CreateEnvironmentTemplateVersion' {} Maybe Text
a -> CreateEnvironmentTemplateVersion
s {$sel:clientToken:CreateEnvironmentTemplateVersion' :: Maybe Text
clientToken = Maybe Text
a} :: CreateEnvironmentTemplateVersion)

-- | A description of the new version of an environment template.
createEnvironmentTemplateVersion_description :: Lens.Lens' CreateEnvironmentTemplateVersion (Prelude.Maybe Prelude.Text)
createEnvironmentTemplateVersion_description :: Lens' CreateEnvironmentTemplateVersion (Maybe Text)
createEnvironmentTemplateVersion_description = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateEnvironmentTemplateVersion' {Maybe (Sensitive Text)
description :: Maybe (Sensitive Text)
$sel:description:CreateEnvironmentTemplateVersion' :: CreateEnvironmentTemplateVersion -> Maybe (Sensitive Text)
description} -> Maybe (Sensitive Text)
description) (\s :: CreateEnvironmentTemplateVersion
s@CreateEnvironmentTemplateVersion' {} Maybe (Sensitive Text)
a -> CreateEnvironmentTemplateVersion
s {$sel:description:CreateEnvironmentTemplateVersion' :: Maybe (Sensitive Text)
description = Maybe (Sensitive Text)
a} :: CreateEnvironmentTemplateVersion) 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

-- | To create a new minor version of the environment template, include
-- @major Version@.
--
-- To create a new major and minor version of the environment template,
-- exclude @major Version@.
createEnvironmentTemplateVersion_majorVersion :: Lens.Lens' CreateEnvironmentTemplateVersion (Prelude.Maybe Prelude.Text)
createEnvironmentTemplateVersion_majorVersion :: Lens' CreateEnvironmentTemplateVersion (Maybe Text)
createEnvironmentTemplateVersion_majorVersion = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateEnvironmentTemplateVersion' {Maybe Text
majorVersion :: Maybe Text
$sel:majorVersion:CreateEnvironmentTemplateVersion' :: CreateEnvironmentTemplateVersion -> Maybe Text
majorVersion} -> Maybe Text
majorVersion) (\s :: CreateEnvironmentTemplateVersion
s@CreateEnvironmentTemplateVersion' {} Maybe Text
a -> CreateEnvironmentTemplateVersion
s {$sel:majorVersion:CreateEnvironmentTemplateVersion' :: Maybe Text
majorVersion = Maybe Text
a} :: CreateEnvironmentTemplateVersion)

-- | An optional list of metadata items that you can associate with the
-- Proton environment template version. A tag is a key-value pair.
--
-- For more information, see
-- <https://docs.aws.amazon.com/proton/latest/userguide/resources.html Proton resources and tagging>
-- in the /Proton User Guide/.
createEnvironmentTemplateVersion_tags :: Lens.Lens' CreateEnvironmentTemplateVersion (Prelude.Maybe [Tag])
createEnvironmentTemplateVersion_tags :: Lens' CreateEnvironmentTemplateVersion (Maybe [Tag])
createEnvironmentTemplateVersion_tags = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateEnvironmentTemplateVersion' {Maybe [Tag]
tags :: Maybe [Tag]
$sel:tags:CreateEnvironmentTemplateVersion' :: CreateEnvironmentTemplateVersion -> Maybe [Tag]
tags} -> Maybe [Tag]
tags) (\s :: CreateEnvironmentTemplateVersion
s@CreateEnvironmentTemplateVersion' {} Maybe [Tag]
a -> CreateEnvironmentTemplateVersion
s {$sel:tags:CreateEnvironmentTemplateVersion' :: Maybe [Tag]
tags = Maybe [Tag]
a} :: CreateEnvironmentTemplateVersion) 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

-- | An object that includes the template bundle S3 bucket path and name for
-- the new version of an template.
createEnvironmentTemplateVersion_source :: Lens.Lens' CreateEnvironmentTemplateVersion TemplateVersionSourceInput
createEnvironmentTemplateVersion_source :: Lens' CreateEnvironmentTemplateVersion TemplateVersionSourceInput
createEnvironmentTemplateVersion_source = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateEnvironmentTemplateVersion' {TemplateVersionSourceInput
source :: TemplateVersionSourceInput
$sel:source:CreateEnvironmentTemplateVersion' :: CreateEnvironmentTemplateVersion -> TemplateVersionSourceInput
source} -> TemplateVersionSourceInput
source) (\s :: CreateEnvironmentTemplateVersion
s@CreateEnvironmentTemplateVersion' {} TemplateVersionSourceInput
a -> CreateEnvironmentTemplateVersion
s {$sel:source:CreateEnvironmentTemplateVersion' :: TemplateVersionSourceInput
source = TemplateVersionSourceInput
a} :: CreateEnvironmentTemplateVersion)

-- | The name of the environment template.
createEnvironmentTemplateVersion_templateName :: Lens.Lens' CreateEnvironmentTemplateVersion Prelude.Text
createEnvironmentTemplateVersion_templateName :: Lens' CreateEnvironmentTemplateVersion Text
createEnvironmentTemplateVersion_templateName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateEnvironmentTemplateVersion' {Text
templateName :: Text
$sel:templateName:CreateEnvironmentTemplateVersion' :: CreateEnvironmentTemplateVersion -> Text
templateName} -> Text
templateName) (\s :: CreateEnvironmentTemplateVersion
s@CreateEnvironmentTemplateVersion' {} Text
a -> CreateEnvironmentTemplateVersion
s {$sel:templateName:CreateEnvironmentTemplateVersion' :: Text
templateName = Text
a} :: CreateEnvironmentTemplateVersion)

instance
  Core.AWSRequest
    CreateEnvironmentTemplateVersion
  where
  type
    AWSResponse CreateEnvironmentTemplateVersion =
      CreateEnvironmentTemplateVersionResponse
  request :: (Service -> Service)
-> CreateEnvironmentTemplateVersion
-> Request CreateEnvironmentTemplateVersion
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 CreateEnvironmentTemplateVersion
-> ClientResponse ClientBody
-> m (Either
        Error
        (ClientResponse (AWSResponse CreateEnvironmentTemplateVersion)))
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
-> EnvironmentTemplateVersion
-> CreateEnvironmentTemplateVersionResponse
CreateEnvironmentTemplateVersionResponse'
            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
"environmentTemplateVersion")
      )

instance
  Prelude.Hashable
    CreateEnvironmentTemplateVersion
  where
  hashWithSalt :: Int -> CreateEnvironmentTemplateVersion -> Int
hashWithSalt
    Int
_salt
    CreateEnvironmentTemplateVersion' {Maybe [Tag]
Maybe Text
Maybe (Sensitive Text)
Text
TemplateVersionSourceInput
templateName :: Text
source :: TemplateVersionSourceInput
tags :: Maybe [Tag]
majorVersion :: Maybe Text
description :: Maybe (Sensitive Text)
clientToken :: Maybe Text
$sel:templateName:CreateEnvironmentTemplateVersion' :: CreateEnvironmentTemplateVersion -> Text
$sel:source:CreateEnvironmentTemplateVersion' :: CreateEnvironmentTemplateVersion -> TemplateVersionSourceInput
$sel:tags:CreateEnvironmentTemplateVersion' :: CreateEnvironmentTemplateVersion -> Maybe [Tag]
$sel:majorVersion:CreateEnvironmentTemplateVersion' :: CreateEnvironmentTemplateVersion -> Maybe Text
$sel:description:CreateEnvironmentTemplateVersion' :: CreateEnvironmentTemplateVersion -> Maybe (Sensitive Text)
$sel:clientToken:CreateEnvironmentTemplateVersion' :: CreateEnvironmentTemplateVersion -> 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` Maybe (Sensitive Text)
description
        forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
majorVersion
        forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [Tag]
tags
        forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` TemplateVersionSourceInput
source
        forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
templateName

instance
  Prelude.NFData
    CreateEnvironmentTemplateVersion
  where
  rnf :: CreateEnvironmentTemplateVersion -> ()
rnf CreateEnvironmentTemplateVersion' {Maybe [Tag]
Maybe Text
Maybe (Sensitive Text)
Text
TemplateVersionSourceInput
templateName :: Text
source :: TemplateVersionSourceInput
tags :: Maybe [Tag]
majorVersion :: Maybe Text
description :: Maybe (Sensitive Text)
clientToken :: Maybe Text
$sel:templateName:CreateEnvironmentTemplateVersion' :: CreateEnvironmentTemplateVersion -> Text
$sel:source:CreateEnvironmentTemplateVersion' :: CreateEnvironmentTemplateVersion -> TemplateVersionSourceInput
$sel:tags:CreateEnvironmentTemplateVersion' :: CreateEnvironmentTemplateVersion -> Maybe [Tag]
$sel:majorVersion:CreateEnvironmentTemplateVersion' :: CreateEnvironmentTemplateVersion -> Maybe Text
$sel:description:CreateEnvironmentTemplateVersion' :: CreateEnvironmentTemplateVersion -> Maybe (Sensitive Text)
$sel:clientToken:CreateEnvironmentTemplateVersion' :: CreateEnvironmentTemplateVersion -> 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 Maybe (Sensitive Text)
description
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
majorVersion
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [Tag]
tags
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf TemplateVersionSourceInput
source
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
templateName

instance
  Data.ToHeaders
    CreateEnvironmentTemplateVersion
  where
  toHeaders :: CreateEnvironmentTemplateVersion -> 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.CreateEnvironmentTemplateVersion" ::
                          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 CreateEnvironmentTemplateVersion where
  toJSON :: CreateEnvironmentTemplateVersion -> Value
toJSON CreateEnvironmentTemplateVersion' {Maybe [Tag]
Maybe Text
Maybe (Sensitive Text)
Text
TemplateVersionSourceInput
templateName :: Text
source :: TemplateVersionSourceInput
tags :: Maybe [Tag]
majorVersion :: Maybe Text
description :: Maybe (Sensitive Text)
clientToken :: Maybe Text
$sel:templateName:CreateEnvironmentTemplateVersion' :: CreateEnvironmentTemplateVersion -> Text
$sel:source:CreateEnvironmentTemplateVersion' :: CreateEnvironmentTemplateVersion -> TemplateVersionSourceInput
$sel:tags:CreateEnvironmentTemplateVersion' :: CreateEnvironmentTemplateVersion -> Maybe [Tag]
$sel:majorVersion:CreateEnvironmentTemplateVersion' :: CreateEnvironmentTemplateVersion -> Maybe Text
$sel:description:CreateEnvironmentTemplateVersion' :: CreateEnvironmentTemplateVersion -> Maybe (Sensitive Text)
$sel:clientToken:CreateEnvironmentTemplateVersion' :: CreateEnvironmentTemplateVersion -> 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,
            (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
"majorVersion" 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
majorVersion,
            (Key
"tags" 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 [Tag]
tags,
            forall a. a -> Maybe a
Prelude.Just (Key
"source" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= TemplateVersionSourceInput
source),
            forall a. a -> Maybe a
Prelude.Just (Key
"templateName" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
templateName)
          ]
      )

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

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

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

-- |
-- Create a value of 'CreateEnvironmentTemplateVersionResponse' 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', 'createEnvironmentTemplateVersionResponse_httpStatus' - The response's http status code.
--
-- 'environmentTemplateVersion', 'createEnvironmentTemplateVersionResponse_environmentTemplateVersion' - The environment template detail data that\'s returned by Proton.
newCreateEnvironmentTemplateVersionResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  -- | 'environmentTemplateVersion'
  EnvironmentTemplateVersion ->
  CreateEnvironmentTemplateVersionResponse
newCreateEnvironmentTemplateVersionResponse :: Int
-> EnvironmentTemplateVersion
-> CreateEnvironmentTemplateVersionResponse
newCreateEnvironmentTemplateVersionResponse
  Int
pHttpStatus_
  EnvironmentTemplateVersion
pEnvironmentTemplateVersion_ =
    CreateEnvironmentTemplateVersionResponse'
      { $sel:httpStatus:CreateEnvironmentTemplateVersionResponse' :: Int
httpStatus =
          Int
pHttpStatus_,
        $sel:environmentTemplateVersion:CreateEnvironmentTemplateVersionResponse' :: EnvironmentTemplateVersion
environmentTemplateVersion =
          EnvironmentTemplateVersion
pEnvironmentTemplateVersion_
      }

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

-- | The environment template detail data that\'s returned by Proton.
createEnvironmentTemplateVersionResponse_environmentTemplateVersion :: Lens.Lens' CreateEnvironmentTemplateVersionResponse EnvironmentTemplateVersion
createEnvironmentTemplateVersionResponse_environmentTemplateVersion :: Lens'
  CreateEnvironmentTemplateVersionResponse EnvironmentTemplateVersion
createEnvironmentTemplateVersionResponse_environmentTemplateVersion = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateEnvironmentTemplateVersionResponse' {EnvironmentTemplateVersion
environmentTemplateVersion :: EnvironmentTemplateVersion
$sel:environmentTemplateVersion:CreateEnvironmentTemplateVersionResponse' :: CreateEnvironmentTemplateVersionResponse
-> EnvironmentTemplateVersion
environmentTemplateVersion} -> EnvironmentTemplateVersion
environmentTemplateVersion) (\s :: CreateEnvironmentTemplateVersionResponse
s@CreateEnvironmentTemplateVersionResponse' {} EnvironmentTemplateVersion
a -> CreateEnvironmentTemplateVersionResponse
s {$sel:environmentTemplateVersion:CreateEnvironmentTemplateVersionResponse' :: EnvironmentTemplateVersion
environmentTemplateVersion = EnvironmentTemplateVersion
a} :: CreateEnvironmentTemplateVersionResponse)

instance
  Prelude.NFData
    CreateEnvironmentTemplateVersionResponse
  where
  rnf :: CreateEnvironmentTemplateVersionResponse -> ()
rnf CreateEnvironmentTemplateVersionResponse' {Int
EnvironmentTemplateVersion
environmentTemplateVersion :: EnvironmentTemplateVersion
httpStatus :: Int
$sel:environmentTemplateVersion:CreateEnvironmentTemplateVersionResponse' :: CreateEnvironmentTemplateVersionResponse
-> EnvironmentTemplateVersion
$sel:httpStatus:CreateEnvironmentTemplateVersionResponse' :: CreateEnvironmentTemplateVersionResponse -> 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 EnvironmentTemplateVersion
environmentTemplateVersion