{-# 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.DrS.UpdateLaunchConfiguration
-- 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 a LaunchConfiguration by Source Server ID.
module Amazonka.DrS.UpdateLaunchConfiguration
  ( -- * Creating a Request
    UpdateLaunchConfiguration (..),
    newUpdateLaunchConfiguration,

    -- * Request Lenses
    updateLaunchConfiguration_copyPrivateIp,
    updateLaunchConfiguration_copyTags,
    updateLaunchConfiguration_launchDisposition,
    updateLaunchConfiguration_licensing,
    updateLaunchConfiguration_name,
    updateLaunchConfiguration_targetInstanceTypeRightSizingMethod,
    updateLaunchConfiguration_sourceServerID,

    -- * Destructuring the Response
    LaunchConfiguration (..),
    newLaunchConfiguration,

    -- * Response Lenses
    launchConfiguration_copyPrivateIp,
    launchConfiguration_copyTags,
    launchConfiguration_ec2LaunchTemplateID,
    launchConfiguration_launchDisposition,
    launchConfiguration_licensing,
    launchConfiguration_name,
    launchConfiguration_sourceServerID,
    launchConfiguration_targetInstanceTypeRightSizingMethod,
  )
where

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

-- | /See:/ 'newUpdateLaunchConfiguration' smart constructor.
data UpdateLaunchConfiguration = UpdateLaunchConfiguration'
  { -- | Whether we should copy the Private IP of the Source Server to the
    -- Recovery Instance.
    UpdateLaunchConfiguration -> Maybe Bool
copyPrivateIp :: Prelude.Maybe Prelude.Bool,
    -- | Whether we want to copy the tags of the Source Server to the EC2 machine
    -- of the Recovery Instance.
    UpdateLaunchConfiguration -> Maybe Bool
copyTags :: Prelude.Maybe Prelude.Bool,
    -- | The state of the Recovery Instance in EC2 after the recovery operation.
    UpdateLaunchConfiguration -> Maybe LaunchDisposition
launchDisposition :: Prelude.Maybe LaunchDisposition,
    -- | The licensing configuration to be used for this launch configuration.
    UpdateLaunchConfiguration -> Maybe Licensing
licensing :: Prelude.Maybe Licensing,
    -- | The name of the launch configuration.
    UpdateLaunchConfiguration -> Maybe Text
name :: Prelude.Maybe Prelude.Text,
    -- | Whether Elastic Disaster Recovery should try to automatically choose the
    -- instance type that best matches the OS, CPU, and RAM of your Source
    -- Server.
    UpdateLaunchConfiguration
-> Maybe TargetInstanceTypeRightSizingMethod
targetInstanceTypeRightSizingMethod :: Prelude.Maybe TargetInstanceTypeRightSizingMethod,
    -- | The ID of the Source Server that we want to retrieve a Launch
    -- Configuration for.
    UpdateLaunchConfiguration -> Text
sourceServerID :: Prelude.Text
  }
  deriving (UpdateLaunchConfiguration -> UpdateLaunchConfiguration -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UpdateLaunchConfiguration -> UpdateLaunchConfiguration -> Bool
$c/= :: UpdateLaunchConfiguration -> UpdateLaunchConfiguration -> Bool
== :: UpdateLaunchConfiguration -> UpdateLaunchConfiguration -> Bool
$c== :: UpdateLaunchConfiguration -> UpdateLaunchConfiguration -> Bool
Prelude.Eq, ReadPrec [UpdateLaunchConfiguration]
ReadPrec UpdateLaunchConfiguration
Int -> ReadS UpdateLaunchConfiguration
ReadS [UpdateLaunchConfiguration]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [UpdateLaunchConfiguration]
$creadListPrec :: ReadPrec [UpdateLaunchConfiguration]
readPrec :: ReadPrec UpdateLaunchConfiguration
$creadPrec :: ReadPrec UpdateLaunchConfiguration
readList :: ReadS [UpdateLaunchConfiguration]
$creadList :: ReadS [UpdateLaunchConfiguration]
readsPrec :: Int -> ReadS UpdateLaunchConfiguration
$creadsPrec :: Int -> ReadS UpdateLaunchConfiguration
Prelude.Read, Int -> UpdateLaunchConfiguration -> ShowS
[UpdateLaunchConfiguration] -> ShowS
UpdateLaunchConfiguration -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UpdateLaunchConfiguration] -> ShowS
$cshowList :: [UpdateLaunchConfiguration] -> ShowS
show :: UpdateLaunchConfiguration -> String
$cshow :: UpdateLaunchConfiguration -> String
showsPrec :: Int -> UpdateLaunchConfiguration -> ShowS
$cshowsPrec :: Int -> UpdateLaunchConfiguration -> ShowS
Prelude.Show, forall x.
Rep UpdateLaunchConfiguration x -> UpdateLaunchConfiguration
forall x.
UpdateLaunchConfiguration -> Rep UpdateLaunchConfiguration x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep UpdateLaunchConfiguration x -> UpdateLaunchConfiguration
$cfrom :: forall x.
UpdateLaunchConfiguration -> Rep UpdateLaunchConfiguration x
Prelude.Generic)

-- |
-- Create a value of 'UpdateLaunchConfiguration' 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:
--
-- 'copyPrivateIp', 'updateLaunchConfiguration_copyPrivateIp' - Whether we should copy the Private IP of the Source Server to the
-- Recovery Instance.
--
-- 'copyTags', 'updateLaunchConfiguration_copyTags' - Whether we want to copy the tags of the Source Server to the EC2 machine
-- of the Recovery Instance.
--
-- 'launchDisposition', 'updateLaunchConfiguration_launchDisposition' - The state of the Recovery Instance in EC2 after the recovery operation.
--
-- 'licensing', 'updateLaunchConfiguration_licensing' - The licensing configuration to be used for this launch configuration.
--
-- 'name', 'updateLaunchConfiguration_name' - The name of the launch configuration.
--
-- 'targetInstanceTypeRightSizingMethod', 'updateLaunchConfiguration_targetInstanceTypeRightSizingMethod' - Whether Elastic Disaster Recovery should try to automatically choose the
-- instance type that best matches the OS, CPU, and RAM of your Source
-- Server.
--
-- 'sourceServerID', 'updateLaunchConfiguration_sourceServerID' - The ID of the Source Server that we want to retrieve a Launch
-- Configuration for.
newUpdateLaunchConfiguration ::
  -- | 'sourceServerID'
  Prelude.Text ->
  UpdateLaunchConfiguration
newUpdateLaunchConfiguration :: Text -> UpdateLaunchConfiguration
newUpdateLaunchConfiguration Text
pSourceServerID_ =
  UpdateLaunchConfiguration'
    { $sel:copyPrivateIp:UpdateLaunchConfiguration' :: Maybe Bool
copyPrivateIp =
        forall a. Maybe a
Prelude.Nothing,
      $sel:copyTags:UpdateLaunchConfiguration' :: Maybe Bool
copyTags = forall a. Maybe a
Prelude.Nothing,
      $sel:launchDisposition:UpdateLaunchConfiguration' :: Maybe LaunchDisposition
launchDisposition = forall a. Maybe a
Prelude.Nothing,
      $sel:licensing:UpdateLaunchConfiguration' :: Maybe Licensing
licensing = forall a. Maybe a
Prelude.Nothing,
      $sel:name:UpdateLaunchConfiguration' :: Maybe Text
name = forall a. Maybe a
Prelude.Nothing,
      $sel:targetInstanceTypeRightSizingMethod:UpdateLaunchConfiguration' :: Maybe TargetInstanceTypeRightSizingMethod
targetInstanceTypeRightSizingMethod =
        forall a. Maybe a
Prelude.Nothing,
      $sel:sourceServerID:UpdateLaunchConfiguration' :: Text
sourceServerID = Text
pSourceServerID_
    }

-- | Whether we should copy the Private IP of the Source Server to the
-- Recovery Instance.
updateLaunchConfiguration_copyPrivateIp :: Lens.Lens' UpdateLaunchConfiguration (Prelude.Maybe Prelude.Bool)
updateLaunchConfiguration_copyPrivateIp :: Lens' UpdateLaunchConfiguration (Maybe Bool)
updateLaunchConfiguration_copyPrivateIp = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateLaunchConfiguration' {Maybe Bool
copyPrivateIp :: Maybe Bool
$sel:copyPrivateIp:UpdateLaunchConfiguration' :: UpdateLaunchConfiguration -> Maybe Bool
copyPrivateIp} -> Maybe Bool
copyPrivateIp) (\s :: UpdateLaunchConfiguration
s@UpdateLaunchConfiguration' {} Maybe Bool
a -> UpdateLaunchConfiguration
s {$sel:copyPrivateIp:UpdateLaunchConfiguration' :: Maybe Bool
copyPrivateIp = Maybe Bool
a} :: UpdateLaunchConfiguration)

-- | Whether we want to copy the tags of the Source Server to the EC2 machine
-- of the Recovery Instance.
updateLaunchConfiguration_copyTags :: Lens.Lens' UpdateLaunchConfiguration (Prelude.Maybe Prelude.Bool)
updateLaunchConfiguration_copyTags :: Lens' UpdateLaunchConfiguration (Maybe Bool)
updateLaunchConfiguration_copyTags = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateLaunchConfiguration' {Maybe Bool
copyTags :: Maybe Bool
$sel:copyTags:UpdateLaunchConfiguration' :: UpdateLaunchConfiguration -> Maybe Bool
copyTags} -> Maybe Bool
copyTags) (\s :: UpdateLaunchConfiguration
s@UpdateLaunchConfiguration' {} Maybe Bool
a -> UpdateLaunchConfiguration
s {$sel:copyTags:UpdateLaunchConfiguration' :: Maybe Bool
copyTags = Maybe Bool
a} :: UpdateLaunchConfiguration)

-- | The state of the Recovery Instance in EC2 after the recovery operation.
updateLaunchConfiguration_launchDisposition :: Lens.Lens' UpdateLaunchConfiguration (Prelude.Maybe LaunchDisposition)
updateLaunchConfiguration_launchDisposition :: Lens' UpdateLaunchConfiguration (Maybe LaunchDisposition)
updateLaunchConfiguration_launchDisposition = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateLaunchConfiguration' {Maybe LaunchDisposition
launchDisposition :: Maybe LaunchDisposition
$sel:launchDisposition:UpdateLaunchConfiguration' :: UpdateLaunchConfiguration -> Maybe LaunchDisposition
launchDisposition} -> Maybe LaunchDisposition
launchDisposition) (\s :: UpdateLaunchConfiguration
s@UpdateLaunchConfiguration' {} Maybe LaunchDisposition
a -> UpdateLaunchConfiguration
s {$sel:launchDisposition:UpdateLaunchConfiguration' :: Maybe LaunchDisposition
launchDisposition = Maybe LaunchDisposition
a} :: UpdateLaunchConfiguration)

-- | The licensing configuration to be used for this launch configuration.
updateLaunchConfiguration_licensing :: Lens.Lens' UpdateLaunchConfiguration (Prelude.Maybe Licensing)
updateLaunchConfiguration_licensing :: Lens' UpdateLaunchConfiguration (Maybe Licensing)
updateLaunchConfiguration_licensing = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateLaunchConfiguration' {Maybe Licensing
licensing :: Maybe Licensing
$sel:licensing:UpdateLaunchConfiguration' :: UpdateLaunchConfiguration -> Maybe Licensing
licensing} -> Maybe Licensing
licensing) (\s :: UpdateLaunchConfiguration
s@UpdateLaunchConfiguration' {} Maybe Licensing
a -> UpdateLaunchConfiguration
s {$sel:licensing:UpdateLaunchConfiguration' :: Maybe Licensing
licensing = Maybe Licensing
a} :: UpdateLaunchConfiguration)

-- | The name of the launch configuration.
updateLaunchConfiguration_name :: Lens.Lens' UpdateLaunchConfiguration (Prelude.Maybe Prelude.Text)
updateLaunchConfiguration_name :: Lens' UpdateLaunchConfiguration (Maybe Text)
updateLaunchConfiguration_name = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateLaunchConfiguration' {Maybe Text
name :: Maybe Text
$sel:name:UpdateLaunchConfiguration' :: UpdateLaunchConfiguration -> Maybe Text
name} -> Maybe Text
name) (\s :: UpdateLaunchConfiguration
s@UpdateLaunchConfiguration' {} Maybe Text
a -> UpdateLaunchConfiguration
s {$sel:name:UpdateLaunchConfiguration' :: Maybe Text
name = Maybe Text
a} :: UpdateLaunchConfiguration)

-- | Whether Elastic Disaster Recovery should try to automatically choose the
-- instance type that best matches the OS, CPU, and RAM of your Source
-- Server.
updateLaunchConfiguration_targetInstanceTypeRightSizingMethod :: Lens.Lens' UpdateLaunchConfiguration (Prelude.Maybe TargetInstanceTypeRightSizingMethod)
updateLaunchConfiguration_targetInstanceTypeRightSizingMethod :: Lens'
  UpdateLaunchConfiguration
  (Maybe TargetInstanceTypeRightSizingMethod)
updateLaunchConfiguration_targetInstanceTypeRightSizingMethod = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateLaunchConfiguration' {Maybe TargetInstanceTypeRightSizingMethod
targetInstanceTypeRightSizingMethod :: Maybe TargetInstanceTypeRightSizingMethod
$sel:targetInstanceTypeRightSizingMethod:UpdateLaunchConfiguration' :: UpdateLaunchConfiguration
-> Maybe TargetInstanceTypeRightSizingMethod
targetInstanceTypeRightSizingMethod} -> Maybe TargetInstanceTypeRightSizingMethod
targetInstanceTypeRightSizingMethod) (\s :: UpdateLaunchConfiguration
s@UpdateLaunchConfiguration' {} Maybe TargetInstanceTypeRightSizingMethod
a -> UpdateLaunchConfiguration
s {$sel:targetInstanceTypeRightSizingMethod:UpdateLaunchConfiguration' :: Maybe TargetInstanceTypeRightSizingMethod
targetInstanceTypeRightSizingMethod = Maybe TargetInstanceTypeRightSizingMethod
a} :: UpdateLaunchConfiguration)

-- | The ID of the Source Server that we want to retrieve a Launch
-- Configuration for.
updateLaunchConfiguration_sourceServerID :: Lens.Lens' UpdateLaunchConfiguration Prelude.Text
updateLaunchConfiguration_sourceServerID :: Lens' UpdateLaunchConfiguration Text
updateLaunchConfiguration_sourceServerID = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateLaunchConfiguration' {Text
sourceServerID :: Text
$sel:sourceServerID:UpdateLaunchConfiguration' :: UpdateLaunchConfiguration -> Text
sourceServerID} -> Text
sourceServerID) (\s :: UpdateLaunchConfiguration
s@UpdateLaunchConfiguration' {} Text
a -> UpdateLaunchConfiguration
s {$sel:sourceServerID:UpdateLaunchConfiguration' :: Text
sourceServerID = Text
a} :: UpdateLaunchConfiguration)

instance Core.AWSRequest UpdateLaunchConfiguration where
  type
    AWSResponse UpdateLaunchConfiguration =
      LaunchConfiguration
  request :: (Service -> Service)
-> UpdateLaunchConfiguration -> Request UpdateLaunchConfiguration
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 UpdateLaunchConfiguration
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse UpdateLaunchConfiguration)))
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 -> forall a. FromJSON a => Object -> Either String a
Data.eitherParseJSON Object
x)

instance Prelude.Hashable UpdateLaunchConfiguration where
  hashWithSalt :: Int -> UpdateLaunchConfiguration -> Int
hashWithSalt Int
_salt UpdateLaunchConfiguration' {Maybe Bool
Maybe Text
Maybe LaunchDisposition
Maybe Licensing
Maybe TargetInstanceTypeRightSizingMethod
Text
sourceServerID :: Text
targetInstanceTypeRightSizingMethod :: Maybe TargetInstanceTypeRightSizingMethod
name :: Maybe Text
licensing :: Maybe Licensing
launchDisposition :: Maybe LaunchDisposition
copyTags :: Maybe Bool
copyPrivateIp :: Maybe Bool
$sel:sourceServerID:UpdateLaunchConfiguration' :: UpdateLaunchConfiguration -> Text
$sel:targetInstanceTypeRightSizingMethod:UpdateLaunchConfiguration' :: UpdateLaunchConfiguration
-> Maybe TargetInstanceTypeRightSizingMethod
$sel:name:UpdateLaunchConfiguration' :: UpdateLaunchConfiguration -> Maybe Text
$sel:licensing:UpdateLaunchConfiguration' :: UpdateLaunchConfiguration -> Maybe Licensing
$sel:launchDisposition:UpdateLaunchConfiguration' :: UpdateLaunchConfiguration -> Maybe LaunchDisposition
$sel:copyTags:UpdateLaunchConfiguration' :: UpdateLaunchConfiguration -> Maybe Bool
$sel:copyPrivateIp:UpdateLaunchConfiguration' :: UpdateLaunchConfiguration -> Maybe Bool
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Bool
copyPrivateIp
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Bool
copyTags
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe LaunchDisposition
launchDisposition
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Licensing
licensing
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
name
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe TargetInstanceTypeRightSizingMethod
targetInstanceTypeRightSizingMethod
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
sourceServerID

instance Prelude.NFData UpdateLaunchConfiguration where
  rnf :: UpdateLaunchConfiguration -> ()
rnf UpdateLaunchConfiguration' {Maybe Bool
Maybe Text
Maybe LaunchDisposition
Maybe Licensing
Maybe TargetInstanceTypeRightSizingMethod
Text
sourceServerID :: Text
targetInstanceTypeRightSizingMethod :: Maybe TargetInstanceTypeRightSizingMethod
name :: Maybe Text
licensing :: Maybe Licensing
launchDisposition :: Maybe LaunchDisposition
copyTags :: Maybe Bool
copyPrivateIp :: Maybe Bool
$sel:sourceServerID:UpdateLaunchConfiguration' :: UpdateLaunchConfiguration -> Text
$sel:targetInstanceTypeRightSizingMethod:UpdateLaunchConfiguration' :: UpdateLaunchConfiguration
-> Maybe TargetInstanceTypeRightSizingMethod
$sel:name:UpdateLaunchConfiguration' :: UpdateLaunchConfiguration -> Maybe Text
$sel:licensing:UpdateLaunchConfiguration' :: UpdateLaunchConfiguration -> Maybe Licensing
$sel:launchDisposition:UpdateLaunchConfiguration' :: UpdateLaunchConfiguration -> Maybe LaunchDisposition
$sel:copyTags:UpdateLaunchConfiguration' :: UpdateLaunchConfiguration -> Maybe Bool
$sel:copyPrivateIp:UpdateLaunchConfiguration' :: UpdateLaunchConfiguration -> Maybe Bool
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Bool
copyPrivateIp
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Bool
copyTags
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe LaunchDisposition
launchDisposition
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Licensing
licensing
      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 TargetInstanceTypeRightSizingMethod
targetInstanceTypeRightSizingMethod
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
sourceServerID

instance Data.ToHeaders UpdateLaunchConfiguration where
  toHeaders :: UpdateLaunchConfiguration -> 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 UpdateLaunchConfiguration where
  toJSON :: UpdateLaunchConfiguration -> Value
toJSON UpdateLaunchConfiguration' {Maybe Bool
Maybe Text
Maybe LaunchDisposition
Maybe Licensing
Maybe TargetInstanceTypeRightSizingMethod
Text
sourceServerID :: Text
targetInstanceTypeRightSizingMethod :: Maybe TargetInstanceTypeRightSizingMethod
name :: Maybe Text
licensing :: Maybe Licensing
launchDisposition :: Maybe LaunchDisposition
copyTags :: Maybe Bool
copyPrivateIp :: Maybe Bool
$sel:sourceServerID:UpdateLaunchConfiguration' :: UpdateLaunchConfiguration -> Text
$sel:targetInstanceTypeRightSizingMethod:UpdateLaunchConfiguration' :: UpdateLaunchConfiguration
-> Maybe TargetInstanceTypeRightSizingMethod
$sel:name:UpdateLaunchConfiguration' :: UpdateLaunchConfiguration -> Maybe Text
$sel:licensing:UpdateLaunchConfiguration' :: UpdateLaunchConfiguration -> Maybe Licensing
$sel:launchDisposition:UpdateLaunchConfiguration' :: UpdateLaunchConfiguration -> Maybe LaunchDisposition
$sel:copyTags:UpdateLaunchConfiguration' :: UpdateLaunchConfiguration -> Maybe Bool
$sel:copyPrivateIp:UpdateLaunchConfiguration' :: UpdateLaunchConfiguration -> Maybe Bool
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"copyPrivateIp" 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 Bool
copyPrivateIp,
            (Key
"copyTags" 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 Bool
copyTags,
            (Key
"launchDisposition" 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 LaunchDisposition
launchDisposition,
            (Key
"licensing" 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 Licensing
licensing,
            (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
"targetInstanceTypeRightSizingMethod" 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 TargetInstanceTypeRightSizingMethod
targetInstanceTypeRightSizingMethod,
            forall a. a -> Maybe a
Prelude.Just
              (Key
"sourceServerID" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
sourceServerID)
          ]
      )

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

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