{-# 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.ModifyHosts
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Modify the auto-placement setting of a Dedicated Host. When
-- auto-placement is enabled, any instances that you launch with a tenancy
-- of @host@ but without a specific host ID are placed onto any available
-- Dedicated Host in your account that has auto-placement enabled. When
-- auto-placement is disabled, you need to provide a host ID to have the
-- instance launch onto a specific host. If no host ID is provided, the
-- instance is launched onto a suitable host with auto-placement enabled.
--
-- You can also use this API action to modify a Dedicated Host to support
-- either multiple instance types in an instance family, or to support a
-- specific instance type only.
module Amazonka.EC2.ModifyHosts
  ( -- * Creating a Request
    ModifyHosts (..),
    newModifyHosts,

    -- * Request Lenses
    modifyHosts_autoPlacement,
    modifyHosts_hostRecovery,
    modifyHosts_instanceFamily,
    modifyHosts_instanceType,
    modifyHosts_hostIds,

    -- * Destructuring the Response
    ModifyHostsResponse (..),
    newModifyHostsResponse,

    -- * Response Lenses
    modifyHostsResponse_successful,
    modifyHostsResponse_unsuccessful,
    modifyHostsResponse_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:/ 'newModifyHosts' smart constructor.
data ModifyHosts = ModifyHosts'
  { -- | Specify whether to enable or disable auto-placement.
    ModifyHosts -> Maybe AutoPlacement
autoPlacement :: Prelude.Maybe AutoPlacement,
    -- | Indicates whether to enable or disable host recovery for the Dedicated
    -- Host. For more information, see
    -- <https://docs.aws.amazon.com/AWSEC2/latest/UserGuide/dedicated-hosts-recovery.html Host recovery>
    -- in the /Amazon EC2 User Guide/.
    ModifyHosts -> Maybe HostRecovery
hostRecovery :: Prelude.Maybe HostRecovery,
    -- | Specifies the instance family to be supported by the Dedicated Host.
    -- Specify this parameter to modify a Dedicated Host to support multiple
    -- instance types within its current instance family.
    --
    -- If you want to modify a Dedicated Host to support a specific instance
    -- type only, omit this parameter and specify __InstanceType__ instead. You
    -- cannot specify __InstanceFamily__ and __InstanceType__ in the same
    -- request.
    ModifyHosts -> Maybe Text
instanceFamily :: Prelude.Maybe Prelude.Text,
    -- | Specifies the instance type to be supported by the Dedicated Host.
    -- Specify this parameter to modify a Dedicated Host to support only a
    -- specific instance type.
    --
    -- If you want to modify a Dedicated Host to support multiple instance
    -- types in its current instance family, omit this parameter and specify
    -- __InstanceFamily__ instead. You cannot specify __InstanceType__ and
    -- __InstanceFamily__ in the same request.
    ModifyHosts -> Maybe Text
instanceType :: Prelude.Maybe Prelude.Text,
    -- | The IDs of the Dedicated Hosts to modify.
    ModifyHosts -> [Text]
hostIds :: [Prelude.Text]
  }
  deriving (ModifyHosts -> ModifyHosts -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ModifyHosts -> ModifyHosts -> Bool
$c/= :: ModifyHosts -> ModifyHosts -> Bool
== :: ModifyHosts -> ModifyHosts -> Bool
$c== :: ModifyHosts -> ModifyHosts -> Bool
Prelude.Eq, ReadPrec [ModifyHosts]
ReadPrec ModifyHosts
Int -> ReadS ModifyHosts
ReadS [ModifyHosts]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ModifyHosts]
$creadListPrec :: ReadPrec [ModifyHosts]
readPrec :: ReadPrec ModifyHosts
$creadPrec :: ReadPrec ModifyHosts
readList :: ReadS [ModifyHosts]
$creadList :: ReadS [ModifyHosts]
readsPrec :: Int -> ReadS ModifyHosts
$creadsPrec :: Int -> ReadS ModifyHosts
Prelude.Read, Int -> ModifyHosts -> ShowS
[ModifyHosts] -> ShowS
ModifyHosts -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ModifyHosts] -> ShowS
$cshowList :: [ModifyHosts] -> ShowS
show :: ModifyHosts -> String
$cshow :: ModifyHosts -> String
showsPrec :: Int -> ModifyHosts -> ShowS
$cshowsPrec :: Int -> ModifyHosts -> ShowS
Prelude.Show, forall x. Rep ModifyHosts x -> ModifyHosts
forall x. ModifyHosts -> Rep ModifyHosts x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ModifyHosts x -> ModifyHosts
$cfrom :: forall x. ModifyHosts -> Rep ModifyHosts x
Prelude.Generic)

-- |
-- Create a value of 'ModifyHosts' 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:
--
-- 'autoPlacement', 'modifyHosts_autoPlacement' - Specify whether to enable or disable auto-placement.
--
-- 'hostRecovery', 'modifyHosts_hostRecovery' - Indicates whether to enable or disable host recovery for the Dedicated
-- Host. For more information, see
-- <https://docs.aws.amazon.com/AWSEC2/latest/UserGuide/dedicated-hosts-recovery.html Host recovery>
-- in the /Amazon EC2 User Guide/.
--
-- 'instanceFamily', 'modifyHosts_instanceFamily' - Specifies the instance family to be supported by the Dedicated Host.
-- Specify this parameter to modify a Dedicated Host to support multiple
-- instance types within its current instance family.
--
-- If you want to modify a Dedicated Host to support a specific instance
-- type only, omit this parameter and specify __InstanceType__ instead. You
-- cannot specify __InstanceFamily__ and __InstanceType__ in the same
-- request.
--
-- 'instanceType', 'modifyHosts_instanceType' - Specifies the instance type to be supported by the Dedicated Host.
-- Specify this parameter to modify a Dedicated Host to support only a
-- specific instance type.
--
-- If you want to modify a Dedicated Host to support multiple instance
-- types in its current instance family, omit this parameter and specify
-- __InstanceFamily__ instead. You cannot specify __InstanceType__ and
-- __InstanceFamily__ in the same request.
--
-- 'hostIds', 'modifyHosts_hostIds' - The IDs of the Dedicated Hosts to modify.
newModifyHosts ::
  ModifyHosts
newModifyHosts :: ModifyHosts
newModifyHosts =
  ModifyHosts'
    { $sel:autoPlacement:ModifyHosts' :: Maybe AutoPlacement
autoPlacement = forall a. Maybe a
Prelude.Nothing,
      $sel:hostRecovery:ModifyHosts' :: Maybe HostRecovery
hostRecovery = forall a. Maybe a
Prelude.Nothing,
      $sel:instanceFamily:ModifyHosts' :: Maybe Text
instanceFamily = forall a. Maybe a
Prelude.Nothing,
      $sel:instanceType:ModifyHosts' :: Maybe Text
instanceType = forall a. Maybe a
Prelude.Nothing,
      $sel:hostIds:ModifyHosts' :: [Text]
hostIds = forall a. Monoid a => a
Prelude.mempty
    }

-- | Specify whether to enable or disable auto-placement.
modifyHosts_autoPlacement :: Lens.Lens' ModifyHosts (Prelude.Maybe AutoPlacement)
modifyHosts_autoPlacement :: Lens' ModifyHosts (Maybe AutoPlacement)
modifyHosts_autoPlacement = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ModifyHosts' {Maybe AutoPlacement
autoPlacement :: Maybe AutoPlacement
$sel:autoPlacement:ModifyHosts' :: ModifyHosts -> Maybe AutoPlacement
autoPlacement} -> Maybe AutoPlacement
autoPlacement) (\s :: ModifyHosts
s@ModifyHosts' {} Maybe AutoPlacement
a -> ModifyHosts
s {$sel:autoPlacement:ModifyHosts' :: Maybe AutoPlacement
autoPlacement = Maybe AutoPlacement
a} :: ModifyHosts)

-- | Indicates whether to enable or disable host recovery for the Dedicated
-- Host. For more information, see
-- <https://docs.aws.amazon.com/AWSEC2/latest/UserGuide/dedicated-hosts-recovery.html Host recovery>
-- in the /Amazon EC2 User Guide/.
modifyHosts_hostRecovery :: Lens.Lens' ModifyHosts (Prelude.Maybe HostRecovery)
modifyHosts_hostRecovery :: Lens' ModifyHosts (Maybe HostRecovery)
modifyHosts_hostRecovery = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ModifyHosts' {Maybe HostRecovery
hostRecovery :: Maybe HostRecovery
$sel:hostRecovery:ModifyHosts' :: ModifyHosts -> Maybe HostRecovery
hostRecovery} -> Maybe HostRecovery
hostRecovery) (\s :: ModifyHosts
s@ModifyHosts' {} Maybe HostRecovery
a -> ModifyHosts
s {$sel:hostRecovery:ModifyHosts' :: Maybe HostRecovery
hostRecovery = Maybe HostRecovery
a} :: ModifyHosts)

-- | Specifies the instance family to be supported by the Dedicated Host.
-- Specify this parameter to modify a Dedicated Host to support multiple
-- instance types within its current instance family.
--
-- If you want to modify a Dedicated Host to support a specific instance
-- type only, omit this parameter and specify __InstanceType__ instead. You
-- cannot specify __InstanceFamily__ and __InstanceType__ in the same
-- request.
modifyHosts_instanceFamily :: Lens.Lens' ModifyHosts (Prelude.Maybe Prelude.Text)
modifyHosts_instanceFamily :: Lens' ModifyHosts (Maybe Text)
modifyHosts_instanceFamily = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ModifyHosts' {Maybe Text
instanceFamily :: Maybe Text
$sel:instanceFamily:ModifyHosts' :: ModifyHosts -> Maybe Text
instanceFamily} -> Maybe Text
instanceFamily) (\s :: ModifyHosts
s@ModifyHosts' {} Maybe Text
a -> ModifyHosts
s {$sel:instanceFamily:ModifyHosts' :: Maybe Text
instanceFamily = Maybe Text
a} :: ModifyHosts)

-- | Specifies the instance type to be supported by the Dedicated Host.
-- Specify this parameter to modify a Dedicated Host to support only a
-- specific instance type.
--
-- If you want to modify a Dedicated Host to support multiple instance
-- types in its current instance family, omit this parameter and specify
-- __InstanceFamily__ instead. You cannot specify __InstanceType__ and
-- __InstanceFamily__ in the same request.
modifyHosts_instanceType :: Lens.Lens' ModifyHosts (Prelude.Maybe Prelude.Text)
modifyHosts_instanceType :: Lens' ModifyHosts (Maybe Text)
modifyHosts_instanceType = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ModifyHosts' {Maybe Text
instanceType :: Maybe Text
$sel:instanceType:ModifyHosts' :: ModifyHosts -> Maybe Text
instanceType} -> Maybe Text
instanceType) (\s :: ModifyHosts
s@ModifyHosts' {} Maybe Text
a -> ModifyHosts
s {$sel:instanceType:ModifyHosts' :: Maybe Text
instanceType = Maybe Text
a} :: ModifyHosts)

-- | The IDs of the Dedicated Hosts to modify.
modifyHosts_hostIds :: Lens.Lens' ModifyHosts [Prelude.Text]
modifyHosts_hostIds :: Lens' ModifyHosts [Text]
modifyHosts_hostIds = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ModifyHosts' {[Text]
hostIds :: [Text]
$sel:hostIds:ModifyHosts' :: ModifyHosts -> [Text]
hostIds} -> [Text]
hostIds) (\s :: ModifyHosts
s@ModifyHosts' {} [Text]
a -> ModifyHosts
s {$sel:hostIds:ModifyHosts' :: [Text]
hostIds = [Text]
a} :: ModifyHosts) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Lens.coerced

instance Core.AWSRequest ModifyHosts where
  type AWSResponse ModifyHosts = ModifyHostsResponse
  request :: (Service -> Service) -> ModifyHosts -> Request ModifyHosts
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 ModifyHosts
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse ModifyHosts)))
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 [Text]
-> Maybe [UnsuccessfulItem] -> Int -> ModifyHostsResponse
ModifyHostsResponse'
            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
"successful"
                            forall (f :: * -> *) a. Functor f => f (Maybe a) -> a -> f a
Core..!@ forall a. Monoid a => a
Prelude.mempty
                            forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
Prelude.>>= forall (f :: * -> *) a b.
Applicative f =>
([a] -> f b) -> [a] -> f (Maybe b)
Core.may (forall a. FromXML a => Text -> [Node] -> Either String [a]
Data.parseXMLList Text
"item")
                        )
            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
"unsuccessful"
                            forall (f :: * -> *) a. Functor f => f (Maybe a) -> a -> f a
Core..!@ forall a. Monoid a => a
Prelude.mempty
                            forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
Prelude.>>= forall (f :: * -> *) a b.
Applicative f =>
([a] -> f b) -> [a] -> f (Maybe b)
Core.may (forall a. FromXML a => Text -> [Node] -> Either String [a]
Data.parseXMLList Text
"item")
                        )
            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 ModifyHosts where
  hashWithSalt :: Int -> ModifyHosts -> Int
hashWithSalt Int
_salt ModifyHosts' {[Text]
Maybe Text
Maybe AutoPlacement
Maybe HostRecovery
hostIds :: [Text]
instanceType :: Maybe Text
instanceFamily :: Maybe Text
hostRecovery :: Maybe HostRecovery
autoPlacement :: Maybe AutoPlacement
$sel:hostIds:ModifyHosts' :: ModifyHosts -> [Text]
$sel:instanceType:ModifyHosts' :: ModifyHosts -> Maybe Text
$sel:instanceFamily:ModifyHosts' :: ModifyHosts -> Maybe Text
$sel:hostRecovery:ModifyHosts' :: ModifyHosts -> Maybe HostRecovery
$sel:autoPlacement:ModifyHosts' :: ModifyHosts -> Maybe AutoPlacement
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe AutoPlacement
autoPlacement
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe HostRecovery
hostRecovery
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
instanceFamily
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
instanceType
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` [Text]
hostIds

instance Prelude.NFData ModifyHosts where
  rnf :: ModifyHosts -> ()
rnf ModifyHosts' {[Text]
Maybe Text
Maybe AutoPlacement
Maybe HostRecovery
hostIds :: [Text]
instanceType :: Maybe Text
instanceFamily :: Maybe Text
hostRecovery :: Maybe HostRecovery
autoPlacement :: Maybe AutoPlacement
$sel:hostIds:ModifyHosts' :: ModifyHosts -> [Text]
$sel:instanceType:ModifyHosts' :: ModifyHosts -> Maybe Text
$sel:instanceFamily:ModifyHosts' :: ModifyHosts -> Maybe Text
$sel:hostRecovery:ModifyHosts' :: ModifyHosts -> Maybe HostRecovery
$sel:autoPlacement:ModifyHosts' :: ModifyHosts -> Maybe AutoPlacement
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe AutoPlacement
autoPlacement
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe HostRecovery
hostRecovery
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
instanceFamily
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
instanceType
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf [Text]
hostIds

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

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

instance Data.ToQuery ModifyHosts where
  toQuery :: ModifyHosts -> QueryString
toQuery ModifyHosts' {[Text]
Maybe Text
Maybe AutoPlacement
Maybe HostRecovery
hostIds :: [Text]
instanceType :: Maybe Text
instanceFamily :: Maybe Text
hostRecovery :: Maybe HostRecovery
autoPlacement :: Maybe AutoPlacement
$sel:hostIds:ModifyHosts' :: ModifyHosts -> [Text]
$sel:instanceType:ModifyHosts' :: ModifyHosts -> Maybe Text
$sel:instanceFamily:ModifyHosts' :: ModifyHosts -> Maybe Text
$sel:hostRecovery:ModifyHosts' :: ModifyHosts -> Maybe HostRecovery
$sel:autoPlacement:ModifyHosts' :: ModifyHosts -> Maybe AutoPlacement
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"Action"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: (ByteString
"ModifyHosts" :: Prelude.ByteString),
        ByteString
"Version"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: (ByteString
"2016-11-15" :: Prelude.ByteString),
        ByteString
"AutoPlacement" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe AutoPlacement
autoPlacement,
        ByteString
"HostRecovery" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe HostRecovery
hostRecovery,
        ByteString
"InstanceFamily" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Text
instanceFamily,
        ByteString
"InstanceType" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Text
instanceType,
        forall a.
(IsList a, ToQuery (Item a)) =>
ByteString -> a -> QueryString
Data.toQueryList ByteString
"HostId" [Text]
hostIds
      ]

-- | /See:/ 'newModifyHostsResponse' smart constructor.
data ModifyHostsResponse = ModifyHostsResponse'
  { -- | The IDs of the Dedicated Hosts that were successfully modified.
    ModifyHostsResponse -> Maybe [Text]
successful :: Prelude.Maybe [Prelude.Text],
    -- | The IDs of the Dedicated Hosts that could not be modified. Check whether
    -- the setting you requested can be used.
    ModifyHostsResponse -> Maybe [UnsuccessfulItem]
unsuccessful :: Prelude.Maybe [UnsuccessfulItem],
    -- | The response's http status code.
    ModifyHostsResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (ModifyHostsResponse -> ModifyHostsResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ModifyHostsResponse -> ModifyHostsResponse -> Bool
$c/= :: ModifyHostsResponse -> ModifyHostsResponse -> Bool
== :: ModifyHostsResponse -> ModifyHostsResponse -> Bool
$c== :: ModifyHostsResponse -> ModifyHostsResponse -> Bool
Prelude.Eq, ReadPrec [ModifyHostsResponse]
ReadPrec ModifyHostsResponse
Int -> ReadS ModifyHostsResponse
ReadS [ModifyHostsResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ModifyHostsResponse]
$creadListPrec :: ReadPrec [ModifyHostsResponse]
readPrec :: ReadPrec ModifyHostsResponse
$creadPrec :: ReadPrec ModifyHostsResponse
readList :: ReadS [ModifyHostsResponse]
$creadList :: ReadS [ModifyHostsResponse]
readsPrec :: Int -> ReadS ModifyHostsResponse
$creadsPrec :: Int -> ReadS ModifyHostsResponse
Prelude.Read, Int -> ModifyHostsResponse -> ShowS
[ModifyHostsResponse] -> ShowS
ModifyHostsResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ModifyHostsResponse] -> ShowS
$cshowList :: [ModifyHostsResponse] -> ShowS
show :: ModifyHostsResponse -> String
$cshow :: ModifyHostsResponse -> String
showsPrec :: Int -> ModifyHostsResponse -> ShowS
$cshowsPrec :: Int -> ModifyHostsResponse -> ShowS
Prelude.Show, forall x. Rep ModifyHostsResponse x -> ModifyHostsResponse
forall x. ModifyHostsResponse -> Rep ModifyHostsResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ModifyHostsResponse x -> ModifyHostsResponse
$cfrom :: forall x. ModifyHostsResponse -> Rep ModifyHostsResponse x
Prelude.Generic)

-- |
-- Create a value of 'ModifyHostsResponse' 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:
--
-- 'successful', 'modifyHostsResponse_successful' - The IDs of the Dedicated Hosts that were successfully modified.
--
-- 'unsuccessful', 'modifyHostsResponse_unsuccessful' - The IDs of the Dedicated Hosts that could not be modified. Check whether
-- the setting you requested can be used.
--
-- 'httpStatus', 'modifyHostsResponse_httpStatus' - The response's http status code.
newModifyHostsResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  ModifyHostsResponse
newModifyHostsResponse :: Int -> ModifyHostsResponse
newModifyHostsResponse Int
pHttpStatus_ =
  ModifyHostsResponse'
    { $sel:successful:ModifyHostsResponse' :: Maybe [Text]
successful = forall a. Maybe a
Prelude.Nothing,
      $sel:unsuccessful:ModifyHostsResponse' :: Maybe [UnsuccessfulItem]
unsuccessful = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:ModifyHostsResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | The IDs of the Dedicated Hosts that were successfully modified.
modifyHostsResponse_successful :: Lens.Lens' ModifyHostsResponse (Prelude.Maybe [Prelude.Text])
modifyHostsResponse_successful :: Lens' ModifyHostsResponse (Maybe [Text])
modifyHostsResponse_successful = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ModifyHostsResponse' {Maybe [Text]
successful :: Maybe [Text]
$sel:successful:ModifyHostsResponse' :: ModifyHostsResponse -> Maybe [Text]
successful} -> Maybe [Text]
successful) (\s :: ModifyHostsResponse
s@ModifyHostsResponse' {} Maybe [Text]
a -> ModifyHostsResponse
s {$sel:successful:ModifyHostsResponse' :: Maybe [Text]
successful = Maybe [Text]
a} :: ModifyHostsResponse) 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

-- | The IDs of the Dedicated Hosts that could not be modified. Check whether
-- the setting you requested can be used.
modifyHostsResponse_unsuccessful :: Lens.Lens' ModifyHostsResponse (Prelude.Maybe [UnsuccessfulItem])
modifyHostsResponse_unsuccessful :: Lens' ModifyHostsResponse (Maybe [UnsuccessfulItem])
modifyHostsResponse_unsuccessful = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ModifyHostsResponse' {Maybe [UnsuccessfulItem]
unsuccessful :: Maybe [UnsuccessfulItem]
$sel:unsuccessful:ModifyHostsResponse' :: ModifyHostsResponse -> Maybe [UnsuccessfulItem]
unsuccessful} -> Maybe [UnsuccessfulItem]
unsuccessful) (\s :: ModifyHostsResponse
s@ModifyHostsResponse' {} Maybe [UnsuccessfulItem]
a -> ModifyHostsResponse
s {$sel:unsuccessful:ModifyHostsResponse' :: Maybe [UnsuccessfulItem]
unsuccessful = Maybe [UnsuccessfulItem]
a} :: ModifyHostsResponse) 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

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

instance Prelude.NFData ModifyHostsResponse where
  rnf :: ModifyHostsResponse -> ()
rnf ModifyHostsResponse' {Int
Maybe [Text]
Maybe [UnsuccessfulItem]
httpStatus :: Int
unsuccessful :: Maybe [UnsuccessfulItem]
successful :: Maybe [Text]
$sel:httpStatus:ModifyHostsResponse' :: ModifyHostsResponse -> Int
$sel:unsuccessful:ModifyHostsResponse' :: ModifyHostsResponse -> Maybe [UnsuccessfulItem]
$sel:successful:ModifyHostsResponse' :: ModifyHostsResponse -> Maybe [Text]
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe [Text]
successful
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [UnsuccessfulItem]
unsuccessful
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus