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

    -- * Request Lenses
    updateLaunchConfiguration_bootMode,
    updateLaunchConfiguration_copyPrivateIp,
    updateLaunchConfiguration_copyTags,
    updateLaunchConfiguration_enableMapAutoTagging,
    updateLaunchConfiguration_launchDisposition,
    updateLaunchConfiguration_licensing,
    updateLaunchConfiguration_mapAutoTaggingMpeID,
    updateLaunchConfiguration_name,
    updateLaunchConfiguration_postLaunchActions,
    updateLaunchConfiguration_targetInstanceTypeRightSizingMethod,
    updateLaunchConfiguration_sourceServerID,

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

    -- * Response Lenses
    launchConfiguration_bootMode,
    launchConfiguration_copyPrivateIp,
    launchConfiguration_copyTags,
    launchConfiguration_ec2LaunchTemplateID,
    launchConfiguration_enableMapAutoTagging,
    launchConfiguration_launchDisposition,
    launchConfiguration_licensing,
    launchConfiguration_mapAutoTaggingMpeID,
    launchConfiguration_name,
    launchConfiguration_postLaunchActions,
    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.MGN.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'
  { -- | Update Launch configuration boot mode request.
    UpdateLaunchConfiguration -> Maybe BootMode
bootMode :: Prelude.Maybe BootMode,
    -- | Update Launch configuration copy Private IP request.
    UpdateLaunchConfiguration -> Maybe Bool
copyPrivateIp :: Prelude.Maybe Prelude.Bool,
    -- | Update Launch configuration copy Tags request.
    UpdateLaunchConfiguration -> Maybe Bool
copyTags :: Prelude.Maybe Prelude.Bool,
    -- | Enable map auto tagging.
    UpdateLaunchConfiguration -> Maybe Bool
enableMapAutoTagging :: Prelude.Maybe Prelude.Bool,
    -- | Update Launch configuration launch disposition request.
    UpdateLaunchConfiguration -> Maybe LaunchDisposition
launchDisposition :: Prelude.Maybe LaunchDisposition,
    -- | Update Launch configuration licensing request.
    UpdateLaunchConfiguration -> Maybe Licensing
licensing :: Prelude.Maybe Licensing,
    -- | Launch configuration map auto tagging MPE ID.
    UpdateLaunchConfiguration -> Maybe Text
mapAutoTaggingMpeID :: Prelude.Maybe Prelude.Text,
    -- | Update Launch configuration name request.
    UpdateLaunchConfiguration -> Maybe Text
name :: Prelude.Maybe Prelude.Text,
    UpdateLaunchConfiguration -> Maybe PostLaunchActions
postLaunchActions :: Prelude.Maybe PostLaunchActions,
    -- | Update Launch configuration Target instance right sizing request.
    UpdateLaunchConfiguration
-> Maybe TargetInstanceTypeRightSizingMethod
targetInstanceTypeRightSizingMethod :: Prelude.Maybe TargetInstanceTypeRightSizingMethod,
    -- | Update Launch configuration by Source Server ID request.
    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:
--
-- 'bootMode', 'updateLaunchConfiguration_bootMode' - Update Launch configuration boot mode request.
--
-- 'copyPrivateIp', 'updateLaunchConfiguration_copyPrivateIp' - Update Launch configuration copy Private IP request.
--
-- 'copyTags', 'updateLaunchConfiguration_copyTags' - Update Launch configuration copy Tags request.
--
-- 'enableMapAutoTagging', 'updateLaunchConfiguration_enableMapAutoTagging' - Enable map auto tagging.
--
-- 'launchDisposition', 'updateLaunchConfiguration_launchDisposition' - Update Launch configuration launch disposition request.
--
-- 'licensing', 'updateLaunchConfiguration_licensing' - Update Launch configuration licensing request.
--
-- 'mapAutoTaggingMpeID', 'updateLaunchConfiguration_mapAutoTaggingMpeID' - Launch configuration map auto tagging MPE ID.
--
-- 'name', 'updateLaunchConfiguration_name' - Update Launch configuration name request.
--
-- 'postLaunchActions', 'updateLaunchConfiguration_postLaunchActions' - Undocumented member.
--
-- 'targetInstanceTypeRightSizingMethod', 'updateLaunchConfiguration_targetInstanceTypeRightSizingMethod' - Update Launch configuration Target instance right sizing request.
--
-- 'sourceServerID', 'updateLaunchConfiguration_sourceServerID' - Update Launch configuration by Source Server ID request.
newUpdateLaunchConfiguration ::
  -- | 'sourceServerID'
  Prelude.Text ->
  UpdateLaunchConfiguration
newUpdateLaunchConfiguration :: Text -> UpdateLaunchConfiguration
newUpdateLaunchConfiguration Text
pSourceServerID_ =
  UpdateLaunchConfiguration'
    { $sel:bootMode:UpdateLaunchConfiguration' :: Maybe BootMode
bootMode =
        forall a. Maybe a
Prelude.Nothing,
      $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:enableMapAutoTagging:UpdateLaunchConfiguration' :: Maybe Bool
enableMapAutoTagging = 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:mapAutoTaggingMpeID:UpdateLaunchConfiguration' :: Maybe Text
mapAutoTaggingMpeID = forall a. Maybe a
Prelude.Nothing,
      $sel:name:UpdateLaunchConfiguration' :: Maybe Text
name = forall a. Maybe a
Prelude.Nothing,
      $sel:postLaunchActions:UpdateLaunchConfiguration' :: Maybe PostLaunchActions
postLaunchActions = 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_
    }

-- | Update Launch configuration boot mode request.
updateLaunchConfiguration_bootMode :: Lens.Lens' UpdateLaunchConfiguration (Prelude.Maybe BootMode)
updateLaunchConfiguration_bootMode :: Lens' UpdateLaunchConfiguration (Maybe BootMode)
updateLaunchConfiguration_bootMode = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateLaunchConfiguration' {Maybe BootMode
bootMode :: Maybe BootMode
$sel:bootMode:UpdateLaunchConfiguration' :: UpdateLaunchConfiguration -> Maybe BootMode
bootMode} -> Maybe BootMode
bootMode) (\s :: UpdateLaunchConfiguration
s@UpdateLaunchConfiguration' {} Maybe BootMode
a -> UpdateLaunchConfiguration
s {$sel:bootMode:UpdateLaunchConfiguration' :: Maybe BootMode
bootMode = Maybe BootMode
a} :: UpdateLaunchConfiguration)

-- | Update Launch configuration copy Private IP request.
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)

-- | Update Launch configuration copy Tags request.
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)

-- | Enable map auto tagging.
updateLaunchConfiguration_enableMapAutoTagging :: Lens.Lens' UpdateLaunchConfiguration (Prelude.Maybe Prelude.Bool)
updateLaunchConfiguration_enableMapAutoTagging :: Lens' UpdateLaunchConfiguration (Maybe Bool)
updateLaunchConfiguration_enableMapAutoTagging = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateLaunchConfiguration' {Maybe Bool
enableMapAutoTagging :: Maybe Bool
$sel:enableMapAutoTagging:UpdateLaunchConfiguration' :: UpdateLaunchConfiguration -> Maybe Bool
enableMapAutoTagging} -> Maybe Bool
enableMapAutoTagging) (\s :: UpdateLaunchConfiguration
s@UpdateLaunchConfiguration' {} Maybe Bool
a -> UpdateLaunchConfiguration
s {$sel:enableMapAutoTagging:UpdateLaunchConfiguration' :: Maybe Bool
enableMapAutoTagging = Maybe Bool
a} :: UpdateLaunchConfiguration)

-- | Update Launch configuration launch disposition request.
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)

-- | Update Launch configuration licensing request.
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)

-- | Launch configuration map auto tagging MPE ID.
updateLaunchConfiguration_mapAutoTaggingMpeID :: Lens.Lens' UpdateLaunchConfiguration (Prelude.Maybe Prelude.Text)
updateLaunchConfiguration_mapAutoTaggingMpeID :: Lens' UpdateLaunchConfiguration (Maybe Text)
updateLaunchConfiguration_mapAutoTaggingMpeID = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateLaunchConfiguration' {Maybe Text
mapAutoTaggingMpeID :: Maybe Text
$sel:mapAutoTaggingMpeID:UpdateLaunchConfiguration' :: UpdateLaunchConfiguration -> Maybe Text
mapAutoTaggingMpeID} -> Maybe Text
mapAutoTaggingMpeID) (\s :: UpdateLaunchConfiguration
s@UpdateLaunchConfiguration' {} Maybe Text
a -> UpdateLaunchConfiguration
s {$sel:mapAutoTaggingMpeID:UpdateLaunchConfiguration' :: Maybe Text
mapAutoTaggingMpeID = Maybe Text
a} :: UpdateLaunchConfiguration)

-- | Update Launch configuration name request.
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)

-- | Undocumented member.
updateLaunchConfiguration_postLaunchActions :: Lens.Lens' UpdateLaunchConfiguration (Prelude.Maybe PostLaunchActions)
updateLaunchConfiguration_postLaunchActions :: Lens' UpdateLaunchConfiguration (Maybe PostLaunchActions)
updateLaunchConfiguration_postLaunchActions = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateLaunchConfiguration' {Maybe PostLaunchActions
postLaunchActions :: Maybe PostLaunchActions
$sel:postLaunchActions:UpdateLaunchConfiguration' :: UpdateLaunchConfiguration -> Maybe PostLaunchActions
postLaunchActions} -> Maybe PostLaunchActions
postLaunchActions) (\s :: UpdateLaunchConfiguration
s@UpdateLaunchConfiguration' {} Maybe PostLaunchActions
a -> UpdateLaunchConfiguration
s {$sel:postLaunchActions:UpdateLaunchConfiguration' :: Maybe PostLaunchActions
postLaunchActions = Maybe PostLaunchActions
a} :: UpdateLaunchConfiguration)

-- | Update Launch configuration Target instance right sizing request.
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)

-- | Update Launch configuration by Source Server ID request.
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 BootMode
Maybe LaunchDisposition
Maybe Licensing
Maybe PostLaunchActions
Maybe TargetInstanceTypeRightSizingMethod
Text
sourceServerID :: Text
targetInstanceTypeRightSizingMethod :: Maybe TargetInstanceTypeRightSizingMethod
postLaunchActions :: Maybe PostLaunchActions
name :: Maybe Text
mapAutoTaggingMpeID :: Maybe Text
licensing :: Maybe Licensing
launchDisposition :: Maybe LaunchDisposition
enableMapAutoTagging :: Maybe Bool
copyTags :: Maybe Bool
copyPrivateIp :: Maybe Bool
bootMode :: Maybe BootMode
$sel:sourceServerID:UpdateLaunchConfiguration' :: UpdateLaunchConfiguration -> Text
$sel:targetInstanceTypeRightSizingMethod:UpdateLaunchConfiguration' :: UpdateLaunchConfiguration
-> Maybe TargetInstanceTypeRightSizingMethod
$sel:postLaunchActions:UpdateLaunchConfiguration' :: UpdateLaunchConfiguration -> Maybe PostLaunchActions
$sel:name:UpdateLaunchConfiguration' :: UpdateLaunchConfiguration -> Maybe Text
$sel:mapAutoTaggingMpeID:UpdateLaunchConfiguration' :: UpdateLaunchConfiguration -> Maybe Text
$sel:licensing:UpdateLaunchConfiguration' :: UpdateLaunchConfiguration -> Maybe Licensing
$sel:launchDisposition:UpdateLaunchConfiguration' :: UpdateLaunchConfiguration -> Maybe LaunchDisposition
$sel:enableMapAutoTagging:UpdateLaunchConfiguration' :: UpdateLaunchConfiguration -> Maybe Bool
$sel:copyTags:UpdateLaunchConfiguration' :: UpdateLaunchConfiguration -> Maybe Bool
$sel:copyPrivateIp:UpdateLaunchConfiguration' :: UpdateLaunchConfiguration -> Maybe Bool
$sel:bootMode:UpdateLaunchConfiguration' :: UpdateLaunchConfiguration -> Maybe BootMode
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe BootMode
bootMode
      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 Bool
enableMapAutoTagging
      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
mapAutoTaggingMpeID
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
name
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe PostLaunchActions
postLaunchActions
      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 BootMode
Maybe LaunchDisposition
Maybe Licensing
Maybe PostLaunchActions
Maybe TargetInstanceTypeRightSizingMethod
Text
sourceServerID :: Text
targetInstanceTypeRightSizingMethod :: Maybe TargetInstanceTypeRightSizingMethod
postLaunchActions :: Maybe PostLaunchActions
name :: Maybe Text
mapAutoTaggingMpeID :: Maybe Text
licensing :: Maybe Licensing
launchDisposition :: Maybe LaunchDisposition
enableMapAutoTagging :: Maybe Bool
copyTags :: Maybe Bool
copyPrivateIp :: Maybe Bool
bootMode :: Maybe BootMode
$sel:sourceServerID:UpdateLaunchConfiguration' :: UpdateLaunchConfiguration -> Text
$sel:targetInstanceTypeRightSizingMethod:UpdateLaunchConfiguration' :: UpdateLaunchConfiguration
-> Maybe TargetInstanceTypeRightSizingMethod
$sel:postLaunchActions:UpdateLaunchConfiguration' :: UpdateLaunchConfiguration -> Maybe PostLaunchActions
$sel:name:UpdateLaunchConfiguration' :: UpdateLaunchConfiguration -> Maybe Text
$sel:mapAutoTaggingMpeID:UpdateLaunchConfiguration' :: UpdateLaunchConfiguration -> Maybe Text
$sel:licensing:UpdateLaunchConfiguration' :: UpdateLaunchConfiguration -> Maybe Licensing
$sel:launchDisposition:UpdateLaunchConfiguration' :: UpdateLaunchConfiguration -> Maybe LaunchDisposition
$sel:enableMapAutoTagging:UpdateLaunchConfiguration' :: UpdateLaunchConfiguration -> Maybe Bool
$sel:copyTags:UpdateLaunchConfiguration' :: UpdateLaunchConfiguration -> Maybe Bool
$sel:copyPrivateIp:UpdateLaunchConfiguration' :: UpdateLaunchConfiguration -> Maybe Bool
$sel:bootMode:UpdateLaunchConfiguration' :: UpdateLaunchConfiguration -> Maybe BootMode
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe BootMode
bootMode
      seq :: forall a b. a -> b -> b
`Prelude.seq` 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 Bool
enableMapAutoTagging
      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
mapAutoTaggingMpeID
      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 PostLaunchActions
postLaunchActions
      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 BootMode
Maybe LaunchDisposition
Maybe Licensing
Maybe PostLaunchActions
Maybe TargetInstanceTypeRightSizingMethod
Text
sourceServerID :: Text
targetInstanceTypeRightSizingMethod :: Maybe TargetInstanceTypeRightSizingMethod
postLaunchActions :: Maybe PostLaunchActions
name :: Maybe Text
mapAutoTaggingMpeID :: Maybe Text
licensing :: Maybe Licensing
launchDisposition :: Maybe LaunchDisposition
enableMapAutoTagging :: Maybe Bool
copyTags :: Maybe Bool
copyPrivateIp :: Maybe Bool
bootMode :: Maybe BootMode
$sel:sourceServerID:UpdateLaunchConfiguration' :: UpdateLaunchConfiguration -> Text
$sel:targetInstanceTypeRightSizingMethod:UpdateLaunchConfiguration' :: UpdateLaunchConfiguration
-> Maybe TargetInstanceTypeRightSizingMethod
$sel:postLaunchActions:UpdateLaunchConfiguration' :: UpdateLaunchConfiguration -> Maybe PostLaunchActions
$sel:name:UpdateLaunchConfiguration' :: UpdateLaunchConfiguration -> Maybe Text
$sel:mapAutoTaggingMpeID:UpdateLaunchConfiguration' :: UpdateLaunchConfiguration -> Maybe Text
$sel:licensing:UpdateLaunchConfiguration' :: UpdateLaunchConfiguration -> Maybe Licensing
$sel:launchDisposition:UpdateLaunchConfiguration' :: UpdateLaunchConfiguration -> Maybe LaunchDisposition
$sel:enableMapAutoTagging:UpdateLaunchConfiguration' :: UpdateLaunchConfiguration -> Maybe Bool
$sel:copyTags:UpdateLaunchConfiguration' :: UpdateLaunchConfiguration -> Maybe Bool
$sel:copyPrivateIp:UpdateLaunchConfiguration' :: UpdateLaunchConfiguration -> Maybe Bool
$sel:bootMode:UpdateLaunchConfiguration' :: UpdateLaunchConfiguration -> Maybe BootMode
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"bootMode" 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 BootMode
bootMode,
            (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
"enableMapAutoTagging" 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
enableMapAutoTagging,
            (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
"mapAutoTaggingMpeID" 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
mapAutoTaggingMpeID,
            (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
"postLaunchActions" 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 PostLaunchActions
postLaunchActions,
            (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