{-# 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.ModifyInstancePlacement
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Modifies the placement attributes for a specified instance. You can do
-- the following:
--
-- -   Modify the affinity between an instance and a
--     <https://docs.aws.amazon.com/AWSEC2/latest/UserGuide/dedicated-hosts-overview.html Dedicated Host>.
--     When affinity is set to @host@ and the instance is not associated
--     with a specific Dedicated Host, the next time the instance is
--     launched, it is automatically associated with the host on which it
--     lands. If the instance is restarted or rebooted, this relationship
--     persists.
--
-- -   Change the Dedicated Host with which an instance is associated.
--
-- -   Change the instance tenancy of an instance.
--
-- -   Move an instance to or from a
--     <https://docs.aws.amazon.com/AWSEC2/latest/UserGuide/placement-groups.html placement group>.
--
-- At least one attribute for affinity, host ID, tenancy, or placement
-- group name must be specified in the request. Affinity and tenancy can be
-- modified in the same request.
--
-- To modify the host ID, tenancy, placement group, or partition for an
-- instance, the instance must be in the @stopped@ state.
module Amazonka.EC2.ModifyInstancePlacement
  ( -- * Creating a Request
    ModifyInstancePlacement (..),
    newModifyInstancePlacement,

    -- * Request Lenses
    modifyInstancePlacement_affinity,
    modifyInstancePlacement_groupId,
    modifyInstancePlacement_groupName,
    modifyInstancePlacement_hostId,
    modifyInstancePlacement_hostResourceGroupArn,
    modifyInstancePlacement_partitionNumber,
    modifyInstancePlacement_tenancy,
    modifyInstancePlacement_instanceId,

    -- * Destructuring the Response
    ModifyInstancePlacementResponse (..),
    newModifyInstancePlacementResponse,

    -- * Response Lenses
    modifyInstancePlacementResponse_return,
    modifyInstancePlacementResponse_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:/ 'newModifyInstancePlacement' smart constructor.
data ModifyInstancePlacement = ModifyInstancePlacement'
  { -- | The affinity setting for the instance.
    ModifyInstancePlacement -> Maybe Affinity
affinity :: Prelude.Maybe Affinity,
    -- | The Group Id of a placement group. You must specify the Placement Group
    -- __Group Id__ to launch an instance in a shared placement group.
    ModifyInstancePlacement -> Maybe Text
groupId :: Prelude.Maybe Prelude.Text,
    -- | The name of the placement group in which to place the instance. For
    -- spread placement groups, the instance must have a tenancy of @default@.
    -- For cluster and partition placement groups, the instance must have a
    -- tenancy of @default@ or @dedicated@.
    --
    -- To remove an instance from a placement group, specify an empty string
    -- (\"\").
    ModifyInstancePlacement -> Maybe Text
groupName :: Prelude.Maybe Prelude.Text,
    -- | The ID of the Dedicated Host with which to associate the instance.
    ModifyInstancePlacement -> Maybe Text
hostId :: Prelude.Maybe Prelude.Text,
    -- | The ARN of the host resource group in which to place the instance.
    ModifyInstancePlacement -> Maybe Text
hostResourceGroupArn :: Prelude.Maybe Prelude.Text,
    -- | The number of the partition in which to place the instance. Valid only
    -- if the placement group strategy is set to @partition@.
    ModifyInstancePlacement -> Maybe Int
partitionNumber :: Prelude.Maybe Prelude.Int,
    -- | The tenancy for the instance.
    --
    -- For T3 instances, you can\'t change the tenancy from @dedicated@ to
    -- @host@, or from @host@ to @dedicated@. Attempting to make one of these
    -- unsupported tenancy changes results in the @InvalidTenancy@ error code.
    ModifyInstancePlacement -> Maybe HostTenancy
tenancy :: Prelude.Maybe HostTenancy,
    -- | The ID of the instance that you are modifying.
    ModifyInstancePlacement -> Text
instanceId :: Prelude.Text
  }
  deriving (ModifyInstancePlacement -> ModifyInstancePlacement -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ModifyInstancePlacement -> ModifyInstancePlacement -> Bool
$c/= :: ModifyInstancePlacement -> ModifyInstancePlacement -> Bool
== :: ModifyInstancePlacement -> ModifyInstancePlacement -> Bool
$c== :: ModifyInstancePlacement -> ModifyInstancePlacement -> Bool
Prelude.Eq, ReadPrec [ModifyInstancePlacement]
ReadPrec ModifyInstancePlacement
Int -> ReadS ModifyInstancePlacement
ReadS [ModifyInstancePlacement]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ModifyInstancePlacement]
$creadListPrec :: ReadPrec [ModifyInstancePlacement]
readPrec :: ReadPrec ModifyInstancePlacement
$creadPrec :: ReadPrec ModifyInstancePlacement
readList :: ReadS [ModifyInstancePlacement]
$creadList :: ReadS [ModifyInstancePlacement]
readsPrec :: Int -> ReadS ModifyInstancePlacement
$creadsPrec :: Int -> ReadS ModifyInstancePlacement
Prelude.Read, Int -> ModifyInstancePlacement -> ShowS
[ModifyInstancePlacement] -> ShowS
ModifyInstancePlacement -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ModifyInstancePlacement] -> ShowS
$cshowList :: [ModifyInstancePlacement] -> ShowS
show :: ModifyInstancePlacement -> String
$cshow :: ModifyInstancePlacement -> String
showsPrec :: Int -> ModifyInstancePlacement -> ShowS
$cshowsPrec :: Int -> ModifyInstancePlacement -> ShowS
Prelude.Show, forall x. Rep ModifyInstancePlacement x -> ModifyInstancePlacement
forall x. ModifyInstancePlacement -> Rep ModifyInstancePlacement x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ModifyInstancePlacement x -> ModifyInstancePlacement
$cfrom :: forall x. ModifyInstancePlacement -> Rep ModifyInstancePlacement x
Prelude.Generic)

-- |
-- Create a value of 'ModifyInstancePlacement' 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:
--
-- 'affinity', 'modifyInstancePlacement_affinity' - The affinity setting for the instance.
--
-- 'groupId', 'modifyInstancePlacement_groupId' - The Group Id of a placement group. You must specify the Placement Group
-- __Group Id__ to launch an instance in a shared placement group.
--
-- 'groupName', 'modifyInstancePlacement_groupName' - The name of the placement group in which to place the instance. For
-- spread placement groups, the instance must have a tenancy of @default@.
-- For cluster and partition placement groups, the instance must have a
-- tenancy of @default@ or @dedicated@.
--
-- To remove an instance from a placement group, specify an empty string
-- (\"\").
--
-- 'hostId', 'modifyInstancePlacement_hostId' - The ID of the Dedicated Host with which to associate the instance.
--
-- 'hostResourceGroupArn', 'modifyInstancePlacement_hostResourceGroupArn' - The ARN of the host resource group in which to place the instance.
--
-- 'partitionNumber', 'modifyInstancePlacement_partitionNumber' - The number of the partition in which to place the instance. Valid only
-- if the placement group strategy is set to @partition@.
--
-- 'tenancy', 'modifyInstancePlacement_tenancy' - The tenancy for the instance.
--
-- For T3 instances, you can\'t change the tenancy from @dedicated@ to
-- @host@, or from @host@ to @dedicated@. Attempting to make one of these
-- unsupported tenancy changes results in the @InvalidTenancy@ error code.
--
-- 'instanceId', 'modifyInstancePlacement_instanceId' - The ID of the instance that you are modifying.
newModifyInstancePlacement ::
  -- | 'instanceId'
  Prelude.Text ->
  ModifyInstancePlacement
newModifyInstancePlacement :: Text -> ModifyInstancePlacement
newModifyInstancePlacement Text
pInstanceId_ =
  ModifyInstancePlacement'
    { $sel:affinity:ModifyInstancePlacement' :: Maybe Affinity
affinity =
        forall a. Maybe a
Prelude.Nothing,
      $sel:groupId:ModifyInstancePlacement' :: Maybe Text
groupId = forall a. Maybe a
Prelude.Nothing,
      $sel:groupName:ModifyInstancePlacement' :: Maybe Text
groupName = forall a. Maybe a
Prelude.Nothing,
      $sel:hostId:ModifyInstancePlacement' :: Maybe Text
hostId = forall a. Maybe a
Prelude.Nothing,
      $sel:hostResourceGroupArn:ModifyInstancePlacement' :: Maybe Text
hostResourceGroupArn = forall a. Maybe a
Prelude.Nothing,
      $sel:partitionNumber:ModifyInstancePlacement' :: Maybe Int
partitionNumber = forall a. Maybe a
Prelude.Nothing,
      $sel:tenancy:ModifyInstancePlacement' :: Maybe HostTenancy
tenancy = forall a. Maybe a
Prelude.Nothing,
      $sel:instanceId:ModifyInstancePlacement' :: Text
instanceId = Text
pInstanceId_
    }

-- | The affinity setting for the instance.
modifyInstancePlacement_affinity :: Lens.Lens' ModifyInstancePlacement (Prelude.Maybe Affinity)
modifyInstancePlacement_affinity :: Lens' ModifyInstancePlacement (Maybe Affinity)
modifyInstancePlacement_affinity = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ModifyInstancePlacement' {Maybe Affinity
affinity :: Maybe Affinity
$sel:affinity:ModifyInstancePlacement' :: ModifyInstancePlacement -> Maybe Affinity
affinity} -> Maybe Affinity
affinity) (\s :: ModifyInstancePlacement
s@ModifyInstancePlacement' {} Maybe Affinity
a -> ModifyInstancePlacement
s {$sel:affinity:ModifyInstancePlacement' :: Maybe Affinity
affinity = Maybe Affinity
a} :: ModifyInstancePlacement)

-- | The Group Id of a placement group. You must specify the Placement Group
-- __Group Id__ to launch an instance in a shared placement group.
modifyInstancePlacement_groupId :: Lens.Lens' ModifyInstancePlacement (Prelude.Maybe Prelude.Text)
modifyInstancePlacement_groupId :: Lens' ModifyInstancePlacement (Maybe Text)
modifyInstancePlacement_groupId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ModifyInstancePlacement' {Maybe Text
groupId :: Maybe Text
$sel:groupId:ModifyInstancePlacement' :: ModifyInstancePlacement -> Maybe Text
groupId} -> Maybe Text
groupId) (\s :: ModifyInstancePlacement
s@ModifyInstancePlacement' {} Maybe Text
a -> ModifyInstancePlacement
s {$sel:groupId:ModifyInstancePlacement' :: Maybe Text
groupId = Maybe Text
a} :: ModifyInstancePlacement)

-- | The name of the placement group in which to place the instance. For
-- spread placement groups, the instance must have a tenancy of @default@.
-- For cluster and partition placement groups, the instance must have a
-- tenancy of @default@ or @dedicated@.
--
-- To remove an instance from a placement group, specify an empty string
-- (\"\").
modifyInstancePlacement_groupName :: Lens.Lens' ModifyInstancePlacement (Prelude.Maybe Prelude.Text)
modifyInstancePlacement_groupName :: Lens' ModifyInstancePlacement (Maybe Text)
modifyInstancePlacement_groupName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ModifyInstancePlacement' {Maybe Text
groupName :: Maybe Text
$sel:groupName:ModifyInstancePlacement' :: ModifyInstancePlacement -> Maybe Text
groupName} -> Maybe Text
groupName) (\s :: ModifyInstancePlacement
s@ModifyInstancePlacement' {} Maybe Text
a -> ModifyInstancePlacement
s {$sel:groupName:ModifyInstancePlacement' :: Maybe Text
groupName = Maybe Text
a} :: ModifyInstancePlacement)

-- | The ID of the Dedicated Host with which to associate the instance.
modifyInstancePlacement_hostId :: Lens.Lens' ModifyInstancePlacement (Prelude.Maybe Prelude.Text)
modifyInstancePlacement_hostId :: Lens' ModifyInstancePlacement (Maybe Text)
modifyInstancePlacement_hostId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ModifyInstancePlacement' {Maybe Text
hostId :: Maybe Text
$sel:hostId:ModifyInstancePlacement' :: ModifyInstancePlacement -> Maybe Text
hostId} -> Maybe Text
hostId) (\s :: ModifyInstancePlacement
s@ModifyInstancePlacement' {} Maybe Text
a -> ModifyInstancePlacement
s {$sel:hostId:ModifyInstancePlacement' :: Maybe Text
hostId = Maybe Text
a} :: ModifyInstancePlacement)

-- | The ARN of the host resource group in which to place the instance.
modifyInstancePlacement_hostResourceGroupArn :: Lens.Lens' ModifyInstancePlacement (Prelude.Maybe Prelude.Text)
modifyInstancePlacement_hostResourceGroupArn :: Lens' ModifyInstancePlacement (Maybe Text)
modifyInstancePlacement_hostResourceGroupArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ModifyInstancePlacement' {Maybe Text
hostResourceGroupArn :: Maybe Text
$sel:hostResourceGroupArn:ModifyInstancePlacement' :: ModifyInstancePlacement -> Maybe Text
hostResourceGroupArn} -> Maybe Text
hostResourceGroupArn) (\s :: ModifyInstancePlacement
s@ModifyInstancePlacement' {} Maybe Text
a -> ModifyInstancePlacement
s {$sel:hostResourceGroupArn:ModifyInstancePlacement' :: Maybe Text
hostResourceGroupArn = Maybe Text
a} :: ModifyInstancePlacement)

-- | The number of the partition in which to place the instance. Valid only
-- if the placement group strategy is set to @partition@.
modifyInstancePlacement_partitionNumber :: Lens.Lens' ModifyInstancePlacement (Prelude.Maybe Prelude.Int)
modifyInstancePlacement_partitionNumber :: Lens' ModifyInstancePlacement (Maybe Int)
modifyInstancePlacement_partitionNumber = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ModifyInstancePlacement' {Maybe Int
partitionNumber :: Maybe Int
$sel:partitionNumber:ModifyInstancePlacement' :: ModifyInstancePlacement -> Maybe Int
partitionNumber} -> Maybe Int
partitionNumber) (\s :: ModifyInstancePlacement
s@ModifyInstancePlacement' {} Maybe Int
a -> ModifyInstancePlacement
s {$sel:partitionNumber:ModifyInstancePlacement' :: Maybe Int
partitionNumber = Maybe Int
a} :: ModifyInstancePlacement)

-- | The tenancy for the instance.
--
-- For T3 instances, you can\'t change the tenancy from @dedicated@ to
-- @host@, or from @host@ to @dedicated@. Attempting to make one of these
-- unsupported tenancy changes results in the @InvalidTenancy@ error code.
modifyInstancePlacement_tenancy :: Lens.Lens' ModifyInstancePlacement (Prelude.Maybe HostTenancy)
modifyInstancePlacement_tenancy :: Lens' ModifyInstancePlacement (Maybe HostTenancy)
modifyInstancePlacement_tenancy = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ModifyInstancePlacement' {Maybe HostTenancy
tenancy :: Maybe HostTenancy
$sel:tenancy:ModifyInstancePlacement' :: ModifyInstancePlacement -> Maybe HostTenancy
tenancy} -> Maybe HostTenancy
tenancy) (\s :: ModifyInstancePlacement
s@ModifyInstancePlacement' {} Maybe HostTenancy
a -> ModifyInstancePlacement
s {$sel:tenancy:ModifyInstancePlacement' :: Maybe HostTenancy
tenancy = Maybe HostTenancy
a} :: ModifyInstancePlacement)

-- | The ID of the instance that you are modifying.
modifyInstancePlacement_instanceId :: Lens.Lens' ModifyInstancePlacement Prelude.Text
modifyInstancePlacement_instanceId :: Lens' ModifyInstancePlacement Text
modifyInstancePlacement_instanceId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ModifyInstancePlacement' {Text
instanceId :: Text
$sel:instanceId:ModifyInstancePlacement' :: ModifyInstancePlacement -> Text
instanceId} -> Text
instanceId) (\s :: ModifyInstancePlacement
s@ModifyInstancePlacement' {} Text
a -> ModifyInstancePlacement
s {$sel:instanceId:ModifyInstancePlacement' :: Text
instanceId = Text
a} :: ModifyInstancePlacement)

instance Core.AWSRequest ModifyInstancePlacement where
  type
    AWSResponse ModifyInstancePlacement =
      ModifyInstancePlacementResponse
  request :: (Service -> Service)
-> ModifyInstancePlacement -> Request ModifyInstancePlacement
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 ModifyInstancePlacement
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse ModifyInstancePlacement)))
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 Bool -> Int -> ModifyInstancePlacementResponse
ModifyInstancePlacementResponse'
            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
"return")
            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 ModifyInstancePlacement where
  hashWithSalt :: Int -> ModifyInstancePlacement -> Int
hashWithSalt Int
_salt ModifyInstancePlacement' {Maybe Int
Maybe Text
Maybe Affinity
Maybe HostTenancy
Text
instanceId :: Text
tenancy :: Maybe HostTenancy
partitionNumber :: Maybe Int
hostResourceGroupArn :: Maybe Text
hostId :: Maybe Text
groupName :: Maybe Text
groupId :: Maybe Text
affinity :: Maybe Affinity
$sel:instanceId:ModifyInstancePlacement' :: ModifyInstancePlacement -> Text
$sel:tenancy:ModifyInstancePlacement' :: ModifyInstancePlacement -> Maybe HostTenancy
$sel:partitionNumber:ModifyInstancePlacement' :: ModifyInstancePlacement -> Maybe Int
$sel:hostResourceGroupArn:ModifyInstancePlacement' :: ModifyInstancePlacement -> Maybe Text
$sel:hostId:ModifyInstancePlacement' :: ModifyInstancePlacement -> Maybe Text
$sel:groupName:ModifyInstancePlacement' :: ModifyInstancePlacement -> Maybe Text
$sel:groupId:ModifyInstancePlacement' :: ModifyInstancePlacement -> Maybe Text
$sel:affinity:ModifyInstancePlacement' :: ModifyInstancePlacement -> Maybe Affinity
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Affinity
affinity
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
groupId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
groupName
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
hostId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
hostResourceGroupArn
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Int
partitionNumber
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe HostTenancy
tenancy
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
instanceId

instance Prelude.NFData ModifyInstancePlacement where
  rnf :: ModifyInstancePlacement -> ()
rnf ModifyInstancePlacement' {Maybe Int
Maybe Text
Maybe Affinity
Maybe HostTenancy
Text
instanceId :: Text
tenancy :: Maybe HostTenancy
partitionNumber :: Maybe Int
hostResourceGroupArn :: Maybe Text
hostId :: Maybe Text
groupName :: Maybe Text
groupId :: Maybe Text
affinity :: Maybe Affinity
$sel:instanceId:ModifyInstancePlacement' :: ModifyInstancePlacement -> Text
$sel:tenancy:ModifyInstancePlacement' :: ModifyInstancePlacement -> Maybe HostTenancy
$sel:partitionNumber:ModifyInstancePlacement' :: ModifyInstancePlacement -> Maybe Int
$sel:hostResourceGroupArn:ModifyInstancePlacement' :: ModifyInstancePlacement -> Maybe Text
$sel:hostId:ModifyInstancePlacement' :: ModifyInstancePlacement -> Maybe Text
$sel:groupName:ModifyInstancePlacement' :: ModifyInstancePlacement -> Maybe Text
$sel:groupId:ModifyInstancePlacement' :: ModifyInstancePlacement -> Maybe Text
$sel:affinity:ModifyInstancePlacement' :: ModifyInstancePlacement -> Maybe Affinity
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Affinity
affinity
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
groupId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
groupName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
hostId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
hostResourceGroupArn
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Int
partitionNumber
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe HostTenancy
tenancy
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
instanceId

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

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

instance Data.ToQuery ModifyInstancePlacement where
  toQuery :: ModifyInstancePlacement -> QueryString
toQuery ModifyInstancePlacement' {Maybe Int
Maybe Text
Maybe Affinity
Maybe HostTenancy
Text
instanceId :: Text
tenancy :: Maybe HostTenancy
partitionNumber :: Maybe Int
hostResourceGroupArn :: Maybe Text
hostId :: Maybe Text
groupName :: Maybe Text
groupId :: Maybe Text
affinity :: Maybe Affinity
$sel:instanceId:ModifyInstancePlacement' :: ModifyInstancePlacement -> Text
$sel:tenancy:ModifyInstancePlacement' :: ModifyInstancePlacement -> Maybe HostTenancy
$sel:partitionNumber:ModifyInstancePlacement' :: ModifyInstancePlacement -> Maybe Int
$sel:hostResourceGroupArn:ModifyInstancePlacement' :: ModifyInstancePlacement -> Maybe Text
$sel:hostId:ModifyInstancePlacement' :: ModifyInstancePlacement -> Maybe Text
$sel:groupName:ModifyInstancePlacement' :: ModifyInstancePlacement -> Maybe Text
$sel:groupId:ModifyInstancePlacement' :: ModifyInstancePlacement -> Maybe Text
$sel:affinity:ModifyInstancePlacement' :: ModifyInstancePlacement -> Maybe Affinity
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"Action"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: (ByteString
"ModifyInstancePlacement" :: Prelude.ByteString),
        ByteString
"Version"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: (ByteString
"2016-11-15" :: Prelude.ByteString),
        ByteString
"Affinity" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Affinity
affinity,
        ByteString
"GroupId" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Text
groupId,
        ByteString
"GroupName" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Text
groupName,
        ByteString
"HostId" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Text
hostId,
        ByteString
"HostResourceGroupArn" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Text
hostResourceGroupArn,
        ByteString
"PartitionNumber" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Int
partitionNumber,
        ByteString
"Tenancy" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe HostTenancy
tenancy,
        ByteString
"InstanceId" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Text
instanceId
      ]

-- | /See:/ 'newModifyInstancePlacementResponse' smart constructor.
data ModifyInstancePlacementResponse = ModifyInstancePlacementResponse'
  { -- | Is @true@ if the request succeeds, and an error otherwise.
    ModifyInstancePlacementResponse -> Maybe Bool
return' :: Prelude.Maybe Prelude.Bool,
    -- | The response's http status code.
    ModifyInstancePlacementResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (ModifyInstancePlacementResponse
-> ModifyInstancePlacementResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ModifyInstancePlacementResponse
-> ModifyInstancePlacementResponse -> Bool
$c/= :: ModifyInstancePlacementResponse
-> ModifyInstancePlacementResponse -> Bool
== :: ModifyInstancePlacementResponse
-> ModifyInstancePlacementResponse -> Bool
$c== :: ModifyInstancePlacementResponse
-> ModifyInstancePlacementResponse -> Bool
Prelude.Eq, ReadPrec [ModifyInstancePlacementResponse]
ReadPrec ModifyInstancePlacementResponse
Int -> ReadS ModifyInstancePlacementResponse
ReadS [ModifyInstancePlacementResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ModifyInstancePlacementResponse]
$creadListPrec :: ReadPrec [ModifyInstancePlacementResponse]
readPrec :: ReadPrec ModifyInstancePlacementResponse
$creadPrec :: ReadPrec ModifyInstancePlacementResponse
readList :: ReadS [ModifyInstancePlacementResponse]
$creadList :: ReadS [ModifyInstancePlacementResponse]
readsPrec :: Int -> ReadS ModifyInstancePlacementResponse
$creadsPrec :: Int -> ReadS ModifyInstancePlacementResponse
Prelude.Read, Int -> ModifyInstancePlacementResponse -> ShowS
[ModifyInstancePlacementResponse] -> ShowS
ModifyInstancePlacementResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ModifyInstancePlacementResponse] -> ShowS
$cshowList :: [ModifyInstancePlacementResponse] -> ShowS
show :: ModifyInstancePlacementResponse -> String
$cshow :: ModifyInstancePlacementResponse -> String
showsPrec :: Int -> ModifyInstancePlacementResponse -> ShowS
$cshowsPrec :: Int -> ModifyInstancePlacementResponse -> ShowS
Prelude.Show, forall x.
Rep ModifyInstancePlacementResponse x
-> ModifyInstancePlacementResponse
forall x.
ModifyInstancePlacementResponse
-> Rep ModifyInstancePlacementResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep ModifyInstancePlacementResponse x
-> ModifyInstancePlacementResponse
$cfrom :: forall x.
ModifyInstancePlacementResponse
-> Rep ModifyInstancePlacementResponse x
Prelude.Generic)

-- |
-- Create a value of 'ModifyInstancePlacementResponse' 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:
--
-- 'return'', 'modifyInstancePlacementResponse_return' - Is @true@ if the request succeeds, and an error otherwise.
--
-- 'httpStatus', 'modifyInstancePlacementResponse_httpStatus' - The response's http status code.
newModifyInstancePlacementResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  ModifyInstancePlacementResponse
newModifyInstancePlacementResponse :: Int -> ModifyInstancePlacementResponse
newModifyInstancePlacementResponse Int
pHttpStatus_ =
  ModifyInstancePlacementResponse'
    { $sel:return':ModifyInstancePlacementResponse' :: Maybe Bool
return' =
        forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:ModifyInstancePlacementResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | Is @true@ if the request succeeds, and an error otherwise.
modifyInstancePlacementResponse_return :: Lens.Lens' ModifyInstancePlacementResponse (Prelude.Maybe Prelude.Bool)
modifyInstancePlacementResponse_return :: Lens' ModifyInstancePlacementResponse (Maybe Bool)
modifyInstancePlacementResponse_return = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ModifyInstancePlacementResponse' {Maybe Bool
return' :: Maybe Bool
$sel:return':ModifyInstancePlacementResponse' :: ModifyInstancePlacementResponse -> Maybe Bool
return'} -> Maybe Bool
return') (\s :: ModifyInstancePlacementResponse
s@ModifyInstancePlacementResponse' {} Maybe Bool
a -> ModifyInstancePlacementResponse
s {$sel:return':ModifyInstancePlacementResponse' :: Maybe Bool
return' = Maybe Bool
a} :: ModifyInstancePlacementResponse)

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

instance
  Prelude.NFData
    ModifyInstancePlacementResponse
  where
  rnf :: ModifyInstancePlacementResponse -> ()
rnf ModifyInstancePlacementResponse' {Int
Maybe Bool
httpStatus :: Int
return' :: Maybe Bool
$sel:httpStatus:ModifyInstancePlacementResponse' :: ModifyInstancePlacementResponse -> Int
$sel:return':ModifyInstancePlacementResponse' :: ModifyInstancePlacementResponse -> Maybe Bool
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Bool
return'
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus