{-# 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.AllocateHosts
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Allocates a Dedicated Host to your account. At a minimum, specify the
-- supported instance type or instance family, the Availability Zone in
-- which to allocate the host, and the number of hosts to allocate.
module Amazonka.EC2.AllocateHosts
  ( -- * Creating a Request
    AllocateHosts (..),
    newAllocateHosts,

    -- * Request Lenses
    allocateHosts_autoPlacement,
    allocateHosts_clientToken,
    allocateHosts_hostRecovery,
    allocateHosts_instanceFamily,
    allocateHosts_instanceType,
    allocateHosts_outpostArn,
    allocateHosts_tagSpecifications,
    allocateHosts_availabilityZone,
    allocateHosts_quantity,

    -- * Destructuring the Response
    AllocateHostsResponse (..),
    newAllocateHostsResponse,

    -- * Response Lenses
    allocateHostsResponse_hostIds,
    allocateHostsResponse_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:/ 'newAllocateHosts' smart constructor.
data AllocateHosts = AllocateHosts'
  { -- | Indicates whether the host accepts any untargeted instance launches that
    -- match its instance type configuration, or if it only accepts Host
    -- tenancy instance launches that specify its unique host ID. For more
    -- information, see
    -- <https://docs.aws.amazon.com/AWSEC2/latest/UserGuide/how-dedicated-hosts-work.html#dedicated-hosts-understanding Understanding auto-placement and affinity>
    -- in the /Amazon EC2 User Guide/.
    --
    -- Default: @on@
    AllocateHosts -> Maybe AutoPlacement
autoPlacement :: Prelude.Maybe AutoPlacement,
    -- | Unique, case-sensitive identifier that you provide to ensure the
    -- idempotency of the request. For more information, see
    -- <https://docs.aws.amazon.com/AWSEC2/latest/APIReference/Run_Instance_Idempotency.html Ensuring Idempotency>.
    AllocateHosts -> Maybe Text
clientToken :: Prelude.Maybe Prelude.Text,
    -- | Indicates whether to enable or disable host recovery for the Dedicated
    -- Host. Host recovery is disabled by default. For more information, see
    -- <https://docs.aws.amazon.com/AWSEC2/latest/UserGuide/dedicated-hosts-recovery.html Host recovery>
    -- in the /Amazon EC2 User Guide/.
    --
    -- Default: @off@
    AllocateHosts -> Maybe HostRecovery
hostRecovery :: Prelude.Maybe HostRecovery,
    -- | Specifies the instance family to be supported by the Dedicated Hosts. If
    -- you specify an instance family, the Dedicated Hosts support multiple
    -- instance types within that instance family.
    --
    -- If you want the Dedicated Hosts to support a specific instance type
    -- only, omit this parameter and specify __InstanceType__ instead. You
    -- cannot specify __InstanceFamily__ and __InstanceType__ in the same
    -- request.
    AllocateHosts -> Maybe Text
instanceFamily :: Prelude.Maybe Prelude.Text,
    -- | Specifies the instance type to be supported by the Dedicated Hosts. If
    -- you specify an instance type, the Dedicated Hosts support instances of
    -- the specified instance type only.
    --
    -- If you want the Dedicated Hosts to support multiple instance types in a
    -- specific instance family, omit this parameter and specify
    -- __InstanceFamily__ instead. You cannot specify __InstanceType__ and
    -- __InstanceFamily__ in the same request.
    AllocateHosts -> Maybe Text
instanceType :: Prelude.Maybe Prelude.Text,
    -- | The Amazon Resource Name (ARN) of the Amazon Web Services Outpost on
    -- which to allocate the Dedicated Host.
    AllocateHosts -> Maybe Text
outpostArn :: Prelude.Maybe Prelude.Text,
    -- | The tags to apply to the Dedicated Host during creation.
    AllocateHosts -> Maybe [TagSpecification]
tagSpecifications :: Prelude.Maybe [TagSpecification],
    -- | The Availability Zone in which to allocate the Dedicated Host.
    AllocateHosts -> Text
availabilityZone :: Prelude.Text,
    -- | The number of Dedicated Hosts to allocate to your account with these
    -- parameters.
    AllocateHosts -> Int
quantity :: Prelude.Int
  }
  deriving (AllocateHosts -> AllocateHosts -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AllocateHosts -> AllocateHosts -> Bool
$c/= :: AllocateHosts -> AllocateHosts -> Bool
== :: AllocateHosts -> AllocateHosts -> Bool
$c== :: AllocateHosts -> AllocateHosts -> Bool
Prelude.Eq, ReadPrec [AllocateHosts]
ReadPrec AllocateHosts
Int -> ReadS AllocateHosts
ReadS [AllocateHosts]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [AllocateHosts]
$creadListPrec :: ReadPrec [AllocateHosts]
readPrec :: ReadPrec AllocateHosts
$creadPrec :: ReadPrec AllocateHosts
readList :: ReadS [AllocateHosts]
$creadList :: ReadS [AllocateHosts]
readsPrec :: Int -> ReadS AllocateHosts
$creadsPrec :: Int -> ReadS AllocateHosts
Prelude.Read, Int -> AllocateHosts -> ShowS
[AllocateHosts] -> ShowS
AllocateHosts -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AllocateHosts] -> ShowS
$cshowList :: [AllocateHosts] -> ShowS
show :: AllocateHosts -> String
$cshow :: AllocateHosts -> String
showsPrec :: Int -> AllocateHosts -> ShowS
$cshowsPrec :: Int -> AllocateHosts -> ShowS
Prelude.Show, forall x. Rep AllocateHosts x -> AllocateHosts
forall x. AllocateHosts -> Rep AllocateHosts x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep AllocateHosts x -> AllocateHosts
$cfrom :: forall x. AllocateHosts -> Rep AllocateHosts x
Prelude.Generic)

-- |
-- Create a value of 'AllocateHosts' 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', 'allocateHosts_autoPlacement' - Indicates whether the host accepts any untargeted instance launches that
-- match its instance type configuration, or if it only accepts Host
-- tenancy instance launches that specify its unique host ID. For more
-- information, see
-- <https://docs.aws.amazon.com/AWSEC2/latest/UserGuide/how-dedicated-hosts-work.html#dedicated-hosts-understanding Understanding auto-placement and affinity>
-- in the /Amazon EC2 User Guide/.
--
-- Default: @on@
--
-- 'clientToken', 'allocateHosts_clientToken' - Unique, case-sensitive identifier that you provide to ensure the
-- idempotency of the request. For more information, see
-- <https://docs.aws.amazon.com/AWSEC2/latest/APIReference/Run_Instance_Idempotency.html Ensuring Idempotency>.
--
-- 'hostRecovery', 'allocateHosts_hostRecovery' - Indicates whether to enable or disable host recovery for the Dedicated
-- Host. Host recovery is disabled by default. For more information, see
-- <https://docs.aws.amazon.com/AWSEC2/latest/UserGuide/dedicated-hosts-recovery.html Host recovery>
-- in the /Amazon EC2 User Guide/.
--
-- Default: @off@
--
-- 'instanceFamily', 'allocateHosts_instanceFamily' - Specifies the instance family to be supported by the Dedicated Hosts. If
-- you specify an instance family, the Dedicated Hosts support multiple
-- instance types within that instance family.
--
-- If you want the Dedicated Hosts 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', 'allocateHosts_instanceType' - Specifies the instance type to be supported by the Dedicated Hosts. If
-- you specify an instance type, the Dedicated Hosts support instances of
-- the specified instance type only.
--
-- If you want the Dedicated Hosts to support multiple instance types in a
-- specific instance family, omit this parameter and specify
-- __InstanceFamily__ instead. You cannot specify __InstanceType__ and
-- __InstanceFamily__ in the same request.
--
-- 'outpostArn', 'allocateHosts_outpostArn' - The Amazon Resource Name (ARN) of the Amazon Web Services Outpost on
-- which to allocate the Dedicated Host.
--
-- 'tagSpecifications', 'allocateHosts_tagSpecifications' - The tags to apply to the Dedicated Host during creation.
--
-- 'availabilityZone', 'allocateHosts_availabilityZone' - The Availability Zone in which to allocate the Dedicated Host.
--
-- 'quantity', 'allocateHosts_quantity' - The number of Dedicated Hosts to allocate to your account with these
-- parameters.
newAllocateHosts ::
  -- | 'availabilityZone'
  Prelude.Text ->
  -- | 'quantity'
  Prelude.Int ->
  AllocateHosts
newAllocateHosts :: Text -> Int -> AllocateHosts
newAllocateHosts Text
pAvailabilityZone_ Int
pQuantity_ =
  AllocateHosts'
    { $sel:autoPlacement:AllocateHosts' :: Maybe AutoPlacement
autoPlacement = forall a. Maybe a
Prelude.Nothing,
      $sel:clientToken:AllocateHosts' :: Maybe Text
clientToken = forall a. Maybe a
Prelude.Nothing,
      $sel:hostRecovery:AllocateHosts' :: Maybe HostRecovery
hostRecovery = forall a. Maybe a
Prelude.Nothing,
      $sel:instanceFamily:AllocateHosts' :: Maybe Text
instanceFamily = forall a. Maybe a
Prelude.Nothing,
      $sel:instanceType:AllocateHosts' :: Maybe Text
instanceType = forall a. Maybe a
Prelude.Nothing,
      $sel:outpostArn:AllocateHosts' :: Maybe Text
outpostArn = forall a. Maybe a
Prelude.Nothing,
      $sel:tagSpecifications:AllocateHosts' :: Maybe [TagSpecification]
tagSpecifications = forall a. Maybe a
Prelude.Nothing,
      $sel:availabilityZone:AllocateHosts' :: Text
availabilityZone = Text
pAvailabilityZone_,
      $sel:quantity:AllocateHosts' :: Int
quantity = Int
pQuantity_
    }

-- | Indicates whether the host accepts any untargeted instance launches that
-- match its instance type configuration, or if it only accepts Host
-- tenancy instance launches that specify its unique host ID. For more
-- information, see
-- <https://docs.aws.amazon.com/AWSEC2/latest/UserGuide/how-dedicated-hosts-work.html#dedicated-hosts-understanding Understanding auto-placement and affinity>
-- in the /Amazon EC2 User Guide/.
--
-- Default: @on@
allocateHosts_autoPlacement :: Lens.Lens' AllocateHosts (Prelude.Maybe AutoPlacement)
allocateHosts_autoPlacement :: Lens' AllocateHosts (Maybe AutoPlacement)
allocateHosts_autoPlacement = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\AllocateHosts' {Maybe AutoPlacement
autoPlacement :: Maybe AutoPlacement
$sel:autoPlacement:AllocateHosts' :: AllocateHosts -> Maybe AutoPlacement
autoPlacement} -> Maybe AutoPlacement
autoPlacement) (\s :: AllocateHosts
s@AllocateHosts' {} Maybe AutoPlacement
a -> AllocateHosts
s {$sel:autoPlacement:AllocateHosts' :: Maybe AutoPlacement
autoPlacement = Maybe AutoPlacement
a} :: AllocateHosts)

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

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

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

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

-- | The Amazon Resource Name (ARN) of the Amazon Web Services Outpost on
-- which to allocate the Dedicated Host.
allocateHosts_outpostArn :: Lens.Lens' AllocateHosts (Prelude.Maybe Prelude.Text)
allocateHosts_outpostArn :: Lens' AllocateHosts (Maybe Text)
allocateHosts_outpostArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\AllocateHosts' {Maybe Text
outpostArn :: Maybe Text
$sel:outpostArn:AllocateHosts' :: AllocateHosts -> Maybe Text
outpostArn} -> Maybe Text
outpostArn) (\s :: AllocateHosts
s@AllocateHosts' {} Maybe Text
a -> AllocateHosts
s {$sel:outpostArn:AllocateHosts' :: Maybe Text
outpostArn = Maybe Text
a} :: AllocateHosts)

-- | The tags to apply to the Dedicated Host during creation.
allocateHosts_tagSpecifications :: Lens.Lens' AllocateHosts (Prelude.Maybe [TagSpecification])
allocateHosts_tagSpecifications :: Lens' AllocateHosts (Maybe [TagSpecification])
allocateHosts_tagSpecifications = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\AllocateHosts' {Maybe [TagSpecification]
tagSpecifications :: Maybe [TagSpecification]
$sel:tagSpecifications:AllocateHosts' :: AllocateHosts -> Maybe [TagSpecification]
tagSpecifications} -> Maybe [TagSpecification]
tagSpecifications) (\s :: AllocateHosts
s@AllocateHosts' {} Maybe [TagSpecification]
a -> AllocateHosts
s {$sel:tagSpecifications:AllocateHosts' :: Maybe [TagSpecification]
tagSpecifications = Maybe [TagSpecification]
a} :: AllocateHosts) 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 Availability Zone in which to allocate the Dedicated Host.
allocateHosts_availabilityZone :: Lens.Lens' AllocateHosts Prelude.Text
allocateHosts_availabilityZone :: Lens' AllocateHosts Text
allocateHosts_availabilityZone = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\AllocateHosts' {Text
availabilityZone :: Text
$sel:availabilityZone:AllocateHosts' :: AllocateHosts -> Text
availabilityZone} -> Text
availabilityZone) (\s :: AllocateHosts
s@AllocateHosts' {} Text
a -> AllocateHosts
s {$sel:availabilityZone:AllocateHosts' :: Text
availabilityZone = Text
a} :: AllocateHosts)

-- | The number of Dedicated Hosts to allocate to your account with these
-- parameters.
allocateHosts_quantity :: Lens.Lens' AllocateHosts Prelude.Int
allocateHosts_quantity :: Lens' AllocateHosts Int
allocateHosts_quantity = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\AllocateHosts' {Int
quantity :: Int
$sel:quantity:AllocateHosts' :: AllocateHosts -> Int
quantity} -> Int
quantity) (\s :: AllocateHosts
s@AllocateHosts' {} Int
a -> AllocateHosts
s {$sel:quantity:AllocateHosts' :: Int
quantity = Int
a} :: AllocateHosts)

instance Core.AWSRequest AllocateHosts where
  type
    AWSResponse AllocateHosts =
      AllocateHostsResponse
  request :: (Service -> Service) -> AllocateHosts -> Request AllocateHosts
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 AllocateHosts
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse AllocateHosts)))
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] -> Int -> AllocateHostsResponse
AllocateHostsResponse'
            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
"hostIdSet"
                            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 AllocateHosts where
  hashWithSalt :: Int -> AllocateHosts -> Int
hashWithSalt Int
_salt AllocateHosts' {Int
Maybe [TagSpecification]
Maybe Text
Maybe AutoPlacement
Maybe HostRecovery
Text
quantity :: Int
availabilityZone :: Text
tagSpecifications :: Maybe [TagSpecification]
outpostArn :: Maybe Text
instanceType :: Maybe Text
instanceFamily :: Maybe Text
hostRecovery :: Maybe HostRecovery
clientToken :: Maybe Text
autoPlacement :: Maybe AutoPlacement
$sel:quantity:AllocateHosts' :: AllocateHosts -> Int
$sel:availabilityZone:AllocateHosts' :: AllocateHosts -> Text
$sel:tagSpecifications:AllocateHosts' :: AllocateHosts -> Maybe [TagSpecification]
$sel:outpostArn:AllocateHosts' :: AllocateHosts -> Maybe Text
$sel:instanceType:AllocateHosts' :: AllocateHosts -> Maybe Text
$sel:instanceFamily:AllocateHosts' :: AllocateHosts -> Maybe Text
$sel:hostRecovery:AllocateHosts' :: AllocateHosts -> Maybe HostRecovery
$sel:clientToken:AllocateHosts' :: AllocateHosts -> Maybe Text
$sel:autoPlacement:AllocateHosts' :: AllocateHosts -> 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 Text
clientToken
      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` Maybe Text
outpostArn
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [TagSpecification]
tagSpecifications
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
availabilityZone
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Int
quantity

instance Prelude.NFData AllocateHosts where
  rnf :: AllocateHosts -> ()
rnf AllocateHosts' {Int
Maybe [TagSpecification]
Maybe Text
Maybe AutoPlacement
Maybe HostRecovery
Text
quantity :: Int
availabilityZone :: Text
tagSpecifications :: Maybe [TagSpecification]
outpostArn :: Maybe Text
instanceType :: Maybe Text
instanceFamily :: Maybe Text
hostRecovery :: Maybe HostRecovery
clientToken :: Maybe Text
autoPlacement :: Maybe AutoPlacement
$sel:quantity:AllocateHosts' :: AllocateHosts -> Int
$sel:availabilityZone:AllocateHosts' :: AllocateHosts -> Text
$sel:tagSpecifications:AllocateHosts' :: AllocateHosts -> Maybe [TagSpecification]
$sel:outpostArn:AllocateHosts' :: AllocateHosts -> Maybe Text
$sel:instanceType:AllocateHosts' :: AllocateHosts -> Maybe Text
$sel:instanceFamily:AllocateHosts' :: AllocateHosts -> Maybe Text
$sel:hostRecovery:AllocateHosts' :: AllocateHosts -> Maybe HostRecovery
$sel:clientToken:AllocateHosts' :: AllocateHosts -> Maybe Text
$sel:autoPlacement:AllocateHosts' :: AllocateHosts -> 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 Text
clientToken
      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 Maybe Text
outpostArn
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [TagSpecification]
tagSpecifications
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
availabilityZone
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
quantity

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

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

instance Data.ToQuery AllocateHosts where
  toQuery :: AllocateHosts -> QueryString
toQuery AllocateHosts' {Int
Maybe [TagSpecification]
Maybe Text
Maybe AutoPlacement
Maybe HostRecovery
Text
quantity :: Int
availabilityZone :: Text
tagSpecifications :: Maybe [TagSpecification]
outpostArn :: Maybe Text
instanceType :: Maybe Text
instanceFamily :: Maybe Text
hostRecovery :: Maybe HostRecovery
clientToken :: Maybe Text
autoPlacement :: Maybe AutoPlacement
$sel:quantity:AllocateHosts' :: AllocateHosts -> Int
$sel:availabilityZone:AllocateHosts' :: AllocateHosts -> Text
$sel:tagSpecifications:AllocateHosts' :: AllocateHosts -> Maybe [TagSpecification]
$sel:outpostArn:AllocateHosts' :: AllocateHosts -> Maybe Text
$sel:instanceType:AllocateHosts' :: AllocateHosts -> Maybe Text
$sel:instanceFamily:AllocateHosts' :: AllocateHosts -> Maybe Text
$sel:hostRecovery:AllocateHosts' :: AllocateHosts -> Maybe HostRecovery
$sel:clientToken:AllocateHosts' :: AllocateHosts -> Maybe Text
$sel:autoPlacement:AllocateHosts' :: AllocateHosts -> Maybe AutoPlacement
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"Action"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: (ByteString
"AllocateHosts" :: 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
"ClientToken" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Text
clientToken,
        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,
        ByteString
"OutpostArn" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Text
outpostArn,
        forall a. ToQuery a => a -> QueryString
Data.toQuery
          ( forall a.
(IsList a, ToQuery (Item a)) =>
ByteString -> a -> QueryString
Data.toQueryList ByteString
"TagSpecification"
              forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe [TagSpecification]
tagSpecifications
          ),
        ByteString
"AvailabilityZone" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Text
availabilityZone,
        ByteString
"Quantity" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Int
quantity
      ]

-- | Contains the output of AllocateHosts.
--
-- /See:/ 'newAllocateHostsResponse' smart constructor.
data AllocateHostsResponse = AllocateHostsResponse'
  { -- | The ID of the allocated Dedicated Host. This is used to launch an
    -- instance onto a specific host.
    AllocateHostsResponse -> Maybe [Text]
hostIds :: Prelude.Maybe [Prelude.Text],
    -- | The response's http status code.
    AllocateHostsResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (AllocateHostsResponse -> AllocateHostsResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AllocateHostsResponse -> AllocateHostsResponse -> Bool
$c/= :: AllocateHostsResponse -> AllocateHostsResponse -> Bool
== :: AllocateHostsResponse -> AllocateHostsResponse -> Bool
$c== :: AllocateHostsResponse -> AllocateHostsResponse -> Bool
Prelude.Eq, ReadPrec [AllocateHostsResponse]
ReadPrec AllocateHostsResponse
Int -> ReadS AllocateHostsResponse
ReadS [AllocateHostsResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [AllocateHostsResponse]
$creadListPrec :: ReadPrec [AllocateHostsResponse]
readPrec :: ReadPrec AllocateHostsResponse
$creadPrec :: ReadPrec AllocateHostsResponse
readList :: ReadS [AllocateHostsResponse]
$creadList :: ReadS [AllocateHostsResponse]
readsPrec :: Int -> ReadS AllocateHostsResponse
$creadsPrec :: Int -> ReadS AllocateHostsResponse
Prelude.Read, Int -> AllocateHostsResponse -> ShowS
[AllocateHostsResponse] -> ShowS
AllocateHostsResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AllocateHostsResponse] -> ShowS
$cshowList :: [AllocateHostsResponse] -> ShowS
show :: AllocateHostsResponse -> String
$cshow :: AllocateHostsResponse -> String
showsPrec :: Int -> AllocateHostsResponse -> ShowS
$cshowsPrec :: Int -> AllocateHostsResponse -> ShowS
Prelude.Show, forall x. Rep AllocateHostsResponse x -> AllocateHostsResponse
forall x. AllocateHostsResponse -> Rep AllocateHostsResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep AllocateHostsResponse x -> AllocateHostsResponse
$cfrom :: forall x. AllocateHostsResponse -> Rep AllocateHostsResponse x
Prelude.Generic)

-- |
-- Create a value of 'AllocateHostsResponse' 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:
--
-- 'hostIds', 'allocateHostsResponse_hostIds' - The ID of the allocated Dedicated Host. This is used to launch an
-- instance onto a specific host.
--
-- 'httpStatus', 'allocateHostsResponse_httpStatus' - The response's http status code.
newAllocateHostsResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  AllocateHostsResponse
newAllocateHostsResponse :: Int -> AllocateHostsResponse
newAllocateHostsResponse Int
pHttpStatus_ =
  AllocateHostsResponse'
    { $sel:hostIds:AllocateHostsResponse' :: Maybe [Text]
hostIds = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:AllocateHostsResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | The ID of the allocated Dedicated Host. This is used to launch an
-- instance onto a specific host.
allocateHostsResponse_hostIds :: Lens.Lens' AllocateHostsResponse (Prelude.Maybe [Prelude.Text])
allocateHostsResponse_hostIds :: Lens' AllocateHostsResponse (Maybe [Text])
allocateHostsResponse_hostIds = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\AllocateHostsResponse' {Maybe [Text]
hostIds :: Maybe [Text]
$sel:hostIds:AllocateHostsResponse' :: AllocateHostsResponse -> Maybe [Text]
hostIds} -> Maybe [Text]
hostIds) (\s :: AllocateHostsResponse
s@AllocateHostsResponse' {} Maybe [Text]
a -> AllocateHostsResponse
s {$sel:hostIds:AllocateHostsResponse' :: Maybe [Text]
hostIds = Maybe [Text]
a} :: AllocateHostsResponse) 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.
allocateHostsResponse_httpStatus :: Lens.Lens' AllocateHostsResponse Prelude.Int
allocateHostsResponse_httpStatus :: Lens' AllocateHostsResponse Int
allocateHostsResponse_httpStatus = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\AllocateHostsResponse' {Int
httpStatus :: Int
$sel:httpStatus:AllocateHostsResponse' :: AllocateHostsResponse -> Int
httpStatus} -> Int
httpStatus) (\s :: AllocateHostsResponse
s@AllocateHostsResponse' {} Int
a -> AllocateHostsResponse
s {$sel:httpStatus:AllocateHostsResponse' :: Int
httpStatus = Int
a} :: AllocateHostsResponse)

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