{-# 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.EC2.CreateLaunchTemplate
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Creates a launch template.
--
-- A launch template contains the parameters to launch an instance. When
-- you launch an instance using RunInstances, you can specify a launch
-- template instead of providing the launch parameters in the request. For
-- more information, see
-- <https://docs.aws.amazon.com/AWSEC2/latest/UserGuide/ec2-launch-templates.html Launch an instance from a launch template>
-- in the /Amazon Elastic Compute Cloud User Guide/.
--
-- If you want to clone an existing launch template as the basis for
-- creating a new launch template, you can use the Amazon EC2 console. The
-- API, SDKs, and CLI do not support cloning a template. For more
-- information, see
-- <https://docs.aws.amazon.com/AWSEC2/latest/UserGuide/ec2-launch-templates.html#create-launch-template-from-existing-launch-template Create a launch template from an existing launch template>
-- in the /Amazon Elastic Compute Cloud User Guide/.
module Amazonka.EC2.CreateLaunchTemplate
  ( -- * Creating a Request
    CreateLaunchTemplate (..),
    newCreateLaunchTemplate,

    -- * Request Lenses
    createLaunchTemplate_clientToken,
    createLaunchTemplate_dryRun,
    createLaunchTemplate_tagSpecifications,
    createLaunchTemplate_versionDescription,
    createLaunchTemplate_launchTemplateName,
    createLaunchTemplate_launchTemplateData,

    -- * Destructuring the Response
    CreateLaunchTemplateResponse (..),
    newCreateLaunchTemplateResponse,

    -- * Response Lenses
    createLaunchTemplateResponse_launchTemplate,
    createLaunchTemplateResponse_warning,
    createLaunchTemplateResponse_httpStatus,
  )
where

import qualified Amazonka.Core as Core
import qualified Amazonka.Core.Lens.Internal as Lens
import qualified Amazonka.Data as Data
import Amazonka.EC2.Types
import qualified Amazonka.Prelude as Prelude
import qualified Amazonka.Request as Request
import qualified Amazonka.Response as Response

-- | /See:/ 'newCreateLaunchTemplate' smart constructor.
data CreateLaunchTemplate = CreateLaunchTemplate'
  { -- | Unique, case-sensitive identifier you provide to ensure the idempotency
    -- of the request. For more information, see
    -- <https://docs.aws.amazon.com/AWSEC2/latest/APIReference/Run_Instance_Idempotency.html Ensuring idempotency>.
    --
    -- Constraint: Maximum 128 ASCII characters.
    CreateLaunchTemplate -> Maybe Text
clientToken :: Prelude.Maybe Prelude.Text,
    -- | Checks whether you have the required permissions for the action, without
    -- actually making the request, and provides an error response. If you have
    -- the required permissions, the error response is @DryRunOperation@.
    -- Otherwise, it is @UnauthorizedOperation@.
    CreateLaunchTemplate -> Maybe Bool
dryRun :: Prelude.Maybe Prelude.Bool,
    -- | The tags to apply to the launch template on creation. To tag the launch
    -- template, the resource type must be @launch-template@.
    --
    -- To specify the tags for the resources that are created when an instance
    -- is launched, you must use the @TagSpecifications@ parameter in the
    -- <https://docs.aws.amazon.com/AWSEC2/latest/APIReference/API_RequestLaunchTemplateData.html launch template data>
    -- structure.
    CreateLaunchTemplate -> Maybe [TagSpecification]
tagSpecifications :: Prelude.Maybe [TagSpecification],
    -- | A description for the first version of the launch template.
    CreateLaunchTemplate -> Maybe Text
versionDescription :: Prelude.Maybe Prelude.Text,
    -- | A name for the launch template.
    CreateLaunchTemplate -> Text
launchTemplateName :: Prelude.Text,
    -- | The information for the launch template.
    CreateLaunchTemplate -> Sensitive RequestLaunchTemplateData
launchTemplateData :: Data.Sensitive RequestLaunchTemplateData
  }
  deriving (CreateLaunchTemplate -> CreateLaunchTemplate -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateLaunchTemplate -> CreateLaunchTemplate -> Bool
$c/= :: CreateLaunchTemplate -> CreateLaunchTemplate -> Bool
== :: CreateLaunchTemplate -> CreateLaunchTemplate -> Bool
$c== :: CreateLaunchTemplate -> CreateLaunchTemplate -> Bool
Prelude.Eq, Int -> CreateLaunchTemplate -> ShowS
[CreateLaunchTemplate] -> ShowS
CreateLaunchTemplate -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateLaunchTemplate] -> ShowS
$cshowList :: [CreateLaunchTemplate] -> ShowS
show :: CreateLaunchTemplate -> String
$cshow :: CreateLaunchTemplate -> String
showsPrec :: Int -> CreateLaunchTemplate -> ShowS
$cshowsPrec :: Int -> CreateLaunchTemplate -> ShowS
Prelude.Show, forall x. Rep CreateLaunchTemplate x -> CreateLaunchTemplate
forall x. CreateLaunchTemplate -> Rep CreateLaunchTemplate x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CreateLaunchTemplate x -> CreateLaunchTemplate
$cfrom :: forall x. CreateLaunchTemplate -> Rep CreateLaunchTemplate x
Prelude.Generic)

-- |
-- Create a value of 'CreateLaunchTemplate' 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', 'createLaunchTemplate_clientToken' - Unique, case-sensitive identifier you provide to ensure the idempotency
-- of the request. For more information, see
-- <https://docs.aws.amazon.com/AWSEC2/latest/APIReference/Run_Instance_Idempotency.html Ensuring idempotency>.
--
-- Constraint: Maximum 128 ASCII characters.
--
-- 'dryRun', 'createLaunchTemplate_dryRun' - Checks whether you have the required permissions for the action, without
-- actually making the request, and provides an error response. If you have
-- the required permissions, the error response is @DryRunOperation@.
-- Otherwise, it is @UnauthorizedOperation@.
--
-- 'tagSpecifications', 'createLaunchTemplate_tagSpecifications' - The tags to apply to the launch template on creation. To tag the launch
-- template, the resource type must be @launch-template@.
--
-- To specify the tags for the resources that are created when an instance
-- is launched, you must use the @TagSpecifications@ parameter in the
-- <https://docs.aws.amazon.com/AWSEC2/latest/APIReference/API_RequestLaunchTemplateData.html launch template data>
-- structure.
--
-- 'versionDescription', 'createLaunchTemplate_versionDescription' - A description for the first version of the launch template.
--
-- 'launchTemplateName', 'createLaunchTemplate_launchTemplateName' - A name for the launch template.
--
-- 'launchTemplateData', 'createLaunchTemplate_launchTemplateData' - The information for the launch template.
newCreateLaunchTemplate ::
  -- | 'launchTemplateName'
  Prelude.Text ->
  -- | 'launchTemplateData'
  RequestLaunchTemplateData ->
  CreateLaunchTemplate
newCreateLaunchTemplate :: Text -> RequestLaunchTemplateData -> CreateLaunchTemplate
newCreateLaunchTemplate
  Text
pLaunchTemplateName_
  RequestLaunchTemplateData
pLaunchTemplateData_ =
    CreateLaunchTemplate'
      { $sel:clientToken:CreateLaunchTemplate' :: Maybe Text
clientToken =
          forall a. Maybe a
Prelude.Nothing,
        $sel:dryRun:CreateLaunchTemplate' :: Maybe Bool
dryRun = forall a. Maybe a
Prelude.Nothing,
        $sel:tagSpecifications:CreateLaunchTemplate' :: Maybe [TagSpecification]
tagSpecifications = forall a. Maybe a
Prelude.Nothing,
        $sel:versionDescription:CreateLaunchTemplate' :: Maybe Text
versionDescription = forall a. Maybe a
Prelude.Nothing,
        $sel:launchTemplateName:CreateLaunchTemplate' :: Text
launchTemplateName = Text
pLaunchTemplateName_,
        $sel:launchTemplateData:CreateLaunchTemplate' :: Sensitive RequestLaunchTemplateData
launchTemplateData =
          forall a. Iso' (Sensitive a) a
Data._Sensitive forall t b. AReview t b -> b -> t
Lens.# RequestLaunchTemplateData
pLaunchTemplateData_
      }

-- | Unique, case-sensitive identifier you provide to ensure the idempotency
-- of the request. For more information, see
-- <https://docs.aws.amazon.com/AWSEC2/latest/APIReference/Run_Instance_Idempotency.html Ensuring idempotency>.
--
-- Constraint: Maximum 128 ASCII characters.
createLaunchTemplate_clientToken :: Lens.Lens' CreateLaunchTemplate (Prelude.Maybe Prelude.Text)
createLaunchTemplate_clientToken :: Lens' CreateLaunchTemplate (Maybe Text)
createLaunchTemplate_clientToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateLaunchTemplate' {Maybe Text
clientToken :: Maybe Text
$sel:clientToken:CreateLaunchTemplate' :: CreateLaunchTemplate -> Maybe Text
clientToken} -> Maybe Text
clientToken) (\s :: CreateLaunchTemplate
s@CreateLaunchTemplate' {} Maybe Text
a -> CreateLaunchTemplate
s {$sel:clientToken:CreateLaunchTemplate' :: Maybe Text
clientToken = Maybe Text
a} :: CreateLaunchTemplate)

-- | Checks whether you have the required permissions for the action, without
-- actually making the request, and provides an error response. If you have
-- the required permissions, the error response is @DryRunOperation@.
-- Otherwise, it is @UnauthorizedOperation@.
createLaunchTemplate_dryRun :: Lens.Lens' CreateLaunchTemplate (Prelude.Maybe Prelude.Bool)
createLaunchTemplate_dryRun :: Lens' CreateLaunchTemplate (Maybe Bool)
createLaunchTemplate_dryRun = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateLaunchTemplate' {Maybe Bool
dryRun :: Maybe Bool
$sel:dryRun:CreateLaunchTemplate' :: CreateLaunchTemplate -> Maybe Bool
dryRun} -> Maybe Bool
dryRun) (\s :: CreateLaunchTemplate
s@CreateLaunchTemplate' {} Maybe Bool
a -> CreateLaunchTemplate
s {$sel:dryRun:CreateLaunchTemplate' :: Maybe Bool
dryRun = Maybe Bool
a} :: CreateLaunchTemplate)

-- | The tags to apply to the launch template on creation. To tag the launch
-- template, the resource type must be @launch-template@.
--
-- To specify the tags for the resources that are created when an instance
-- is launched, you must use the @TagSpecifications@ parameter in the
-- <https://docs.aws.amazon.com/AWSEC2/latest/APIReference/API_RequestLaunchTemplateData.html launch template data>
-- structure.
createLaunchTemplate_tagSpecifications :: Lens.Lens' CreateLaunchTemplate (Prelude.Maybe [TagSpecification])
createLaunchTemplate_tagSpecifications :: Lens' CreateLaunchTemplate (Maybe [TagSpecification])
createLaunchTemplate_tagSpecifications = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateLaunchTemplate' {Maybe [TagSpecification]
tagSpecifications :: Maybe [TagSpecification]
$sel:tagSpecifications:CreateLaunchTemplate' :: CreateLaunchTemplate -> Maybe [TagSpecification]
tagSpecifications} -> Maybe [TagSpecification]
tagSpecifications) (\s :: CreateLaunchTemplate
s@CreateLaunchTemplate' {} Maybe [TagSpecification]
a -> CreateLaunchTemplate
s {$sel:tagSpecifications:CreateLaunchTemplate' :: Maybe [TagSpecification]
tagSpecifications = Maybe [TagSpecification]
a} :: CreateLaunchTemplate) 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

-- | A description for the first version of the launch template.
createLaunchTemplate_versionDescription :: Lens.Lens' CreateLaunchTemplate (Prelude.Maybe Prelude.Text)
createLaunchTemplate_versionDescription :: Lens' CreateLaunchTemplate (Maybe Text)
createLaunchTemplate_versionDescription = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateLaunchTemplate' {Maybe Text
versionDescription :: Maybe Text
$sel:versionDescription:CreateLaunchTemplate' :: CreateLaunchTemplate -> Maybe Text
versionDescription} -> Maybe Text
versionDescription) (\s :: CreateLaunchTemplate
s@CreateLaunchTemplate' {} Maybe Text
a -> CreateLaunchTemplate
s {$sel:versionDescription:CreateLaunchTemplate' :: Maybe Text
versionDescription = Maybe Text
a} :: CreateLaunchTemplate)

-- | A name for the launch template.
createLaunchTemplate_launchTemplateName :: Lens.Lens' CreateLaunchTemplate Prelude.Text
createLaunchTemplate_launchTemplateName :: Lens' CreateLaunchTemplate Text
createLaunchTemplate_launchTemplateName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateLaunchTemplate' {Text
launchTemplateName :: Text
$sel:launchTemplateName:CreateLaunchTemplate' :: CreateLaunchTemplate -> Text
launchTemplateName} -> Text
launchTemplateName) (\s :: CreateLaunchTemplate
s@CreateLaunchTemplate' {} Text
a -> CreateLaunchTemplate
s {$sel:launchTemplateName:CreateLaunchTemplate' :: Text
launchTemplateName = Text
a} :: CreateLaunchTemplate)

-- | The information for the launch template.
createLaunchTemplate_launchTemplateData :: Lens.Lens' CreateLaunchTemplate RequestLaunchTemplateData
createLaunchTemplate_launchTemplateData :: Lens' CreateLaunchTemplate RequestLaunchTemplateData
createLaunchTemplate_launchTemplateData = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateLaunchTemplate' {Sensitive RequestLaunchTemplateData
launchTemplateData :: Sensitive RequestLaunchTemplateData
$sel:launchTemplateData:CreateLaunchTemplate' :: CreateLaunchTemplate -> Sensitive RequestLaunchTemplateData
launchTemplateData} -> Sensitive RequestLaunchTemplateData
launchTemplateData) (\s :: CreateLaunchTemplate
s@CreateLaunchTemplate' {} Sensitive RequestLaunchTemplateData
a -> CreateLaunchTemplate
s {$sel:launchTemplateData:CreateLaunchTemplate' :: Sensitive RequestLaunchTemplateData
launchTemplateData = Sensitive RequestLaunchTemplateData
a} :: CreateLaunchTemplate) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall a. Iso' (Sensitive a) a
Data._Sensitive

instance Core.AWSRequest CreateLaunchTemplate where
  type
    AWSResponse CreateLaunchTemplate =
      CreateLaunchTemplateResponse
  request :: (Service -> Service)
-> CreateLaunchTemplate -> Request CreateLaunchTemplate
request Service -> Service
overrides =
    forall a. ToRequest a => Service -> a -> Request a
Request.postQuery (Service -> Service
overrides Service
defaultService)
  response :: forall (m :: * -> *).
MonadResource m =>
(ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy CreateLaunchTemplate
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse CreateLaunchTemplate)))
response =
    forall (m :: * -> *) a.
MonadResource m =>
(Int -> ResponseHeaders -> [Node] -> Either String (AWSResponse a))
-> (ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy a
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse a)))
Response.receiveXML
      ( \Int
s ResponseHeaders
h [Node]
x ->
          Maybe LaunchTemplate
-> Maybe ValidationWarning -> Int -> CreateLaunchTemplateResponse
CreateLaunchTemplateResponse'
            forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> ([Node]
x forall a. FromXML a => [Node] -> Text -> Either String (Maybe a)
Data..@? Text
"launchTemplate")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> ([Node]
x forall a. FromXML a => [Node] -> Text -> Either String (Maybe a)
Data..@? Text
"warning")
            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))
      )

instance Prelude.Hashable CreateLaunchTemplate where
  hashWithSalt :: Int -> CreateLaunchTemplate -> Int
hashWithSalt Int
_salt CreateLaunchTemplate' {Maybe Bool
Maybe [TagSpecification]
Maybe Text
Text
Sensitive RequestLaunchTemplateData
launchTemplateData :: Sensitive RequestLaunchTemplateData
launchTemplateName :: Text
versionDescription :: Maybe Text
tagSpecifications :: Maybe [TagSpecification]
dryRun :: Maybe Bool
clientToken :: Maybe Text
$sel:launchTemplateData:CreateLaunchTemplate' :: CreateLaunchTemplate -> Sensitive RequestLaunchTemplateData
$sel:launchTemplateName:CreateLaunchTemplate' :: CreateLaunchTemplate -> Text
$sel:versionDescription:CreateLaunchTemplate' :: CreateLaunchTemplate -> Maybe Text
$sel:tagSpecifications:CreateLaunchTemplate' :: CreateLaunchTemplate -> Maybe [TagSpecification]
$sel:dryRun:CreateLaunchTemplate' :: CreateLaunchTemplate -> Maybe Bool
$sel:clientToken:CreateLaunchTemplate' :: CreateLaunchTemplate -> 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 Bool
dryRun
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [TagSpecification]
tagSpecifications
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
versionDescription
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
launchTemplateName
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Sensitive RequestLaunchTemplateData
launchTemplateData

instance Prelude.NFData CreateLaunchTemplate where
  rnf :: CreateLaunchTemplate -> ()
rnf CreateLaunchTemplate' {Maybe Bool
Maybe [TagSpecification]
Maybe Text
Text
Sensitive RequestLaunchTemplateData
launchTemplateData :: Sensitive RequestLaunchTemplateData
launchTemplateName :: Text
versionDescription :: Maybe Text
tagSpecifications :: Maybe [TagSpecification]
dryRun :: Maybe Bool
clientToken :: Maybe Text
$sel:launchTemplateData:CreateLaunchTemplate' :: CreateLaunchTemplate -> Sensitive RequestLaunchTemplateData
$sel:launchTemplateName:CreateLaunchTemplate' :: CreateLaunchTemplate -> Text
$sel:versionDescription:CreateLaunchTemplate' :: CreateLaunchTemplate -> Maybe Text
$sel:tagSpecifications:CreateLaunchTemplate' :: CreateLaunchTemplate -> Maybe [TagSpecification]
$sel:dryRun:CreateLaunchTemplate' :: CreateLaunchTemplate -> Maybe Bool
$sel:clientToken:CreateLaunchTemplate' :: CreateLaunchTemplate -> 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 Bool
dryRun
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [TagSpecification]
tagSpecifications
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
versionDescription
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
launchTemplateName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Sensitive RequestLaunchTemplateData
launchTemplateData

instance Data.ToHeaders CreateLaunchTemplate where
  toHeaders :: CreateLaunchTemplate -> ResponseHeaders
toHeaders = forall a b. a -> b -> a
Prelude.const forall a. Monoid a => a
Prelude.mempty

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

instance Data.ToQuery CreateLaunchTemplate where
  toQuery :: CreateLaunchTemplate -> QueryString
toQuery CreateLaunchTemplate' {Maybe Bool
Maybe [TagSpecification]
Maybe Text
Text
Sensitive RequestLaunchTemplateData
launchTemplateData :: Sensitive RequestLaunchTemplateData
launchTemplateName :: Text
versionDescription :: Maybe Text
tagSpecifications :: Maybe [TagSpecification]
dryRun :: Maybe Bool
clientToken :: Maybe Text
$sel:launchTemplateData:CreateLaunchTemplate' :: CreateLaunchTemplate -> Sensitive RequestLaunchTemplateData
$sel:launchTemplateName:CreateLaunchTemplate' :: CreateLaunchTemplate -> Text
$sel:versionDescription:CreateLaunchTemplate' :: CreateLaunchTemplate -> Maybe Text
$sel:tagSpecifications:CreateLaunchTemplate' :: CreateLaunchTemplate -> Maybe [TagSpecification]
$sel:dryRun:CreateLaunchTemplate' :: CreateLaunchTemplate -> Maybe Bool
$sel:clientToken:CreateLaunchTemplate' :: CreateLaunchTemplate -> Maybe Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"Action"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: (ByteString
"CreateLaunchTemplate" :: Prelude.ByteString),
        ByteString
"Version"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: (ByteString
"2016-11-15" :: Prelude.ByteString),
        ByteString
"ClientToken" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Text
clientToken,
        ByteString
"DryRun" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Bool
dryRun,
        forall a. ToQuery a => a -> QueryString
Data.toQuery
          ( forall a.
(IsList a, ToQuery (Item a)) =>
ByteString -> a -> QueryString
Data.toQueryList ByteString
"TagSpecification"
              forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe [TagSpecification]
tagSpecifications
          ),
        ByteString
"VersionDescription" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Text
versionDescription,
        ByteString
"LaunchTemplateName" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Text
launchTemplateName,
        ByteString
"LaunchTemplateData" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Sensitive RequestLaunchTemplateData
launchTemplateData
      ]

-- | /See:/ 'newCreateLaunchTemplateResponse' smart constructor.
data CreateLaunchTemplateResponse = CreateLaunchTemplateResponse'
  { -- | Information about the launch template.
    CreateLaunchTemplateResponse -> Maybe LaunchTemplate
launchTemplate :: Prelude.Maybe LaunchTemplate,
    -- | If the launch template contains parameters or parameter combinations
    -- that are not valid, an error code and an error message are returned for
    -- each issue that\'s found.
    CreateLaunchTemplateResponse -> Maybe ValidationWarning
warning :: Prelude.Maybe ValidationWarning,
    -- | The response's http status code.
    CreateLaunchTemplateResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (CreateLaunchTemplateResponse
-> CreateLaunchTemplateResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateLaunchTemplateResponse
-> CreateLaunchTemplateResponse -> Bool
$c/= :: CreateLaunchTemplateResponse
-> CreateLaunchTemplateResponse -> Bool
== :: CreateLaunchTemplateResponse
-> CreateLaunchTemplateResponse -> Bool
$c== :: CreateLaunchTemplateResponse
-> CreateLaunchTemplateResponse -> Bool
Prelude.Eq, ReadPrec [CreateLaunchTemplateResponse]
ReadPrec CreateLaunchTemplateResponse
Int -> ReadS CreateLaunchTemplateResponse
ReadS [CreateLaunchTemplateResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CreateLaunchTemplateResponse]
$creadListPrec :: ReadPrec [CreateLaunchTemplateResponse]
readPrec :: ReadPrec CreateLaunchTemplateResponse
$creadPrec :: ReadPrec CreateLaunchTemplateResponse
readList :: ReadS [CreateLaunchTemplateResponse]
$creadList :: ReadS [CreateLaunchTemplateResponse]
readsPrec :: Int -> ReadS CreateLaunchTemplateResponse
$creadsPrec :: Int -> ReadS CreateLaunchTemplateResponse
Prelude.Read, Int -> CreateLaunchTemplateResponse -> ShowS
[CreateLaunchTemplateResponse] -> ShowS
CreateLaunchTemplateResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateLaunchTemplateResponse] -> ShowS
$cshowList :: [CreateLaunchTemplateResponse] -> ShowS
show :: CreateLaunchTemplateResponse -> String
$cshow :: CreateLaunchTemplateResponse -> String
showsPrec :: Int -> CreateLaunchTemplateResponse -> ShowS
$cshowsPrec :: Int -> CreateLaunchTemplateResponse -> ShowS
Prelude.Show, forall x.
Rep CreateLaunchTemplateResponse x -> CreateLaunchTemplateResponse
forall x.
CreateLaunchTemplateResponse -> Rep CreateLaunchTemplateResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep CreateLaunchTemplateResponse x -> CreateLaunchTemplateResponse
$cfrom :: forall x.
CreateLaunchTemplateResponse -> Rep CreateLaunchTemplateResponse x
Prelude.Generic)

-- |
-- Create a value of 'CreateLaunchTemplateResponse' 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:
--
-- 'launchTemplate', 'createLaunchTemplateResponse_launchTemplate' - Information about the launch template.
--
-- 'warning', 'createLaunchTemplateResponse_warning' - If the launch template contains parameters or parameter combinations
-- that are not valid, an error code and an error message are returned for
-- each issue that\'s found.
--
-- 'httpStatus', 'createLaunchTemplateResponse_httpStatus' - The response's http status code.
newCreateLaunchTemplateResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  CreateLaunchTemplateResponse
newCreateLaunchTemplateResponse :: Int -> CreateLaunchTemplateResponse
newCreateLaunchTemplateResponse Int
pHttpStatus_ =
  CreateLaunchTemplateResponse'
    { $sel:launchTemplate:CreateLaunchTemplateResponse' :: Maybe LaunchTemplate
launchTemplate =
        forall a. Maybe a
Prelude.Nothing,
      $sel:warning:CreateLaunchTemplateResponse' :: Maybe ValidationWarning
warning = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:CreateLaunchTemplateResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | Information about the launch template.
createLaunchTemplateResponse_launchTemplate :: Lens.Lens' CreateLaunchTemplateResponse (Prelude.Maybe LaunchTemplate)
createLaunchTemplateResponse_launchTemplate :: Lens' CreateLaunchTemplateResponse (Maybe LaunchTemplate)
createLaunchTemplateResponse_launchTemplate = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateLaunchTemplateResponse' {Maybe LaunchTemplate
launchTemplate :: Maybe LaunchTemplate
$sel:launchTemplate:CreateLaunchTemplateResponse' :: CreateLaunchTemplateResponse -> Maybe LaunchTemplate
launchTemplate} -> Maybe LaunchTemplate
launchTemplate) (\s :: CreateLaunchTemplateResponse
s@CreateLaunchTemplateResponse' {} Maybe LaunchTemplate
a -> CreateLaunchTemplateResponse
s {$sel:launchTemplate:CreateLaunchTemplateResponse' :: Maybe LaunchTemplate
launchTemplate = Maybe LaunchTemplate
a} :: CreateLaunchTemplateResponse)

-- | If the launch template contains parameters or parameter combinations
-- that are not valid, an error code and an error message are returned for
-- each issue that\'s found.
createLaunchTemplateResponse_warning :: Lens.Lens' CreateLaunchTemplateResponse (Prelude.Maybe ValidationWarning)
createLaunchTemplateResponse_warning :: Lens' CreateLaunchTemplateResponse (Maybe ValidationWarning)
createLaunchTemplateResponse_warning = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateLaunchTemplateResponse' {Maybe ValidationWarning
warning :: Maybe ValidationWarning
$sel:warning:CreateLaunchTemplateResponse' :: CreateLaunchTemplateResponse -> Maybe ValidationWarning
warning} -> Maybe ValidationWarning
warning) (\s :: CreateLaunchTemplateResponse
s@CreateLaunchTemplateResponse' {} Maybe ValidationWarning
a -> CreateLaunchTemplateResponse
s {$sel:warning:CreateLaunchTemplateResponse' :: Maybe ValidationWarning
warning = Maybe ValidationWarning
a} :: CreateLaunchTemplateResponse)

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

instance Prelude.NFData CreateLaunchTemplateResponse where
  rnf :: CreateLaunchTemplateResponse -> ()
rnf CreateLaunchTemplateResponse' {Int
Maybe LaunchTemplate
Maybe ValidationWarning
httpStatus :: Int
warning :: Maybe ValidationWarning
launchTemplate :: Maybe LaunchTemplate
$sel:httpStatus:CreateLaunchTemplateResponse' :: CreateLaunchTemplateResponse -> Int
$sel:warning:CreateLaunchTemplateResponse' :: CreateLaunchTemplateResponse -> Maybe ValidationWarning
$sel:launchTemplate:CreateLaunchTemplateResponse' :: CreateLaunchTemplateResponse -> Maybe LaunchTemplate
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe LaunchTemplate
launchTemplate
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe ValidationWarning
warning
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus