{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE StrictData #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# 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.Types.Host
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
module Amazonka.EC2.Types.Host where

import qualified Amazonka.Core as Core
import qualified Amazonka.Core.Lens.Internal as Lens
import qualified Amazonka.Data as Data
import Amazonka.EC2.Internal
import Amazonka.EC2.Types.AllocationState
import Amazonka.EC2.Types.AllowsMultipleInstanceTypes
import Amazonka.EC2.Types.AutoPlacement
import Amazonka.EC2.Types.AvailableCapacity
import Amazonka.EC2.Types.HostInstance
import Amazonka.EC2.Types.HostProperties
import Amazonka.EC2.Types.HostRecovery
import Amazonka.EC2.Types.Tag
import qualified Amazonka.Prelude as Prelude

-- | Describes the properties of the Dedicated Host.
--
-- /See:/ 'newHost' smart constructor.
data Host = Host'
  { -- | The time that the Dedicated Host was allocated.
    Host -> Maybe ISO8601
allocationTime :: Prelude.Maybe Data.ISO8601,
    -- | Indicates whether the Dedicated Host supports multiple instance types of
    -- the same instance family. If the value is @on@, the Dedicated Host
    -- supports multiple instance types in the instance family. If the value is
    -- @off@, the Dedicated Host supports a single instance type only.
    Host -> Maybe AllowsMultipleInstanceTypes
allowsMultipleInstanceTypes :: Prelude.Maybe AllowsMultipleInstanceTypes,
    -- | Whether auto-placement is on or off.
    Host -> Maybe AutoPlacement
autoPlacement :: Prelude.Maybe AutoPlacement,
    -- | The Availability Zone of the Dedicated Host.
    Host -> Maybe Text
availabilityZone :: Prelude.Maybe Prelude.Text,
    -- | The ID of the Availability Zone in which the Dedicated Host is
    -- allocated.
    Host -> Maybe Text
availabilityZoneId :: Prelude.Maybe Prelude.Text,
    -- | Information about the instances running on the Dedicated Host.
    Host -> Maybe AvailableCapacity
availableCapacity :: Prelude.Maybe AvailableCapacity,
    -- | 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>.
    Host -> Maybe Text
clientToken :: Prelude.Maybe Prelude.Text,
    -- | The ID of the Dedicated Host.
    Host -> Maybe Text
hostId :: Prelude.Maybe Prelude.Text,
    -- | The hardware specifications of the Dedicated Host.
    Host -> Maybe HostProperties
hostProperties :: Prelude.Maybe HostProperties,
    -- | Indicates whether host recovery is enabled or disabled for the Dedicated
    -- Host.
    Host -> Maybe HostRecovery
hostRecovery :: Prelude.Maybe HostRecovery,
    -- | The reservation ID of the Dedicated Host. This returns a @null@ response
    -- if the Dedicated Host doesn\'t have an associated reservation.
    Host -> Maybe Text
hostReservationId :: Prelude.Maybe Prelude.Text,
    -- | The IDs and instance type that are currently running on the Dedicated
    -- Host.
    Host -> Maybe [HostInstance]
instances :: Prelude.Maybe [HostInstance],
    -- | Indicates whether the Dedicated Host is in a host resource group. If
    -- __memberOfServiceLinkedResourceGroup__ is @true@, the host is in a host
    -- resource group; otherwise, it is not.
    Host -> Maybe Bool
memberOfServiceLinkedResourceGroup :: Prelude.Maybe Prelude.Bool,
    -- | The Amazon Resource Name (ARN) of the Amazon Web Services Outpost on
    -- which the Dedicated Host is allocated.
    Host -> Maybe Text
outpostArn :: Prelude.Maybe Prelude.Text,
    -- | The ID of the Amazon Web Services account that owns the Dedicated Host.
    Host -> Maybe Text
ownerId :: Prelude.Maybe Prelude.Text,
    -- | The time that the Dedicated Host was released.
    Host -> Maybe ISO8601
releaseTime :: Prelude.Maybe Data.ISO8601,
    -- | The Dedicated Host\'s state.
    Host -> Maybe AllocationState
state :: Prelude.Maybe AllocationState,
    -- | Any tags assigned to the Dedicated Host.
    Host -> Maybe [Tag]
tags :: Prelude.Maybe [Tag]
  }
  deriving (Host -> Host -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Host -> Host -> Bool
$c/= :: Host -> Host -> Bool
== :: Host -> Host -> Bool
$c== :: Host -> Host -> Bool
Prelude.Eq, ReadPrec [Host]
ReadPrec Host
Int -> ReadS Host
ReadS [Host]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Host]
$creadListPrec :: ReadPrec [Host]
readPrec :: ReadPrec Host
$creadPrec :: ReadPrec Host
readList :: ReadS [Host]
$creadList :: ReadS [Host]
readsPrec :: Int -> ReadS Host
$creadsPrec :: Int -> ReadS Host
Prelude.Read, Int -> Host -> ShowS
[Host] -> ShowS
Host -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Host] -> ShowS
$cshowList :: [Host] -> ShowS
show :: Host -> String
$cshow :: Host -> String
showsPrec :: Int -> Host -> ShowS
$cshowsPrec :: Int -> Host -> ShowS
Prelude.Show, forall x. Rep Host x -> Host
forall x. Host -> Rep Host x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Host x -> Host
$cfrom :: forall x. Host -> Rep Host x
Prelude.Generic)

-- |
-- Create a value of 'Host' 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:
--
-- 'allocationTime', 'host_allocationTime' - The time that the Dedicated Host was allocated.
--
-- 'allowsMultipleInstanceTypes', 'host_allowsMultipleInstanceTypes' - Indicates whether the Dedicated Host supports multiple instance types of
-- the same instance family. If the value is @on@, the Dedicated Host
-- supports multiple instance types in the instance family. If the value is
-- @off@, the Dedicated Host supports a single instance type only.
--
-- 'autoPlacement', 'host_autoPlacement' - Whether auto-placement is on or off.
--
-- 'availabilityZone', 'host_availabilityZone' - The Availability Zone of the Dedicated Host.
--
-- 'availabilityZoneId', 'host_availabilityZoneId' - The ID of the Availability Zone in which the Dedicated Host is
-- allocated.
--
-- 'availableCapacity', 'host_availableCapacity' - Information about the instances running on the Dedicated Host.
--
-- 'clientToken', 'host_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>.
--
-- 'hostId', 'host_hostId' - The ID of the Dedicated Host.
--
-- 'hostProperties', 'host_hostProperties' - The hardware specifications of the Dedicated Host.
--
-- 'hostRecovery', 'host_hostRecovery' - Indicates whether host recovery is enabled or disabled for the Dedicated
-- Host.
--
-- 'hostReservationId', 'host_hostReservationId' - The reservation ID of the Dedicated Host. This returns a @null@ response
-- if the Dedicated Host doesn\'t have an associated reservation.
--
-- 'instances', 'host_instances' - The IDs and instance type that are currently running on the Dedicated
-- Host.
--
-- 'memberOfServiceLinkedResourceGroup', 'host_memberOfServiceLinkedResourceGroup' - Indicates whether the Dedicated Host is in a host resource group. If
-- __memberOfServiceLinkedResourceGroup__ is @true@, the host is in a host
-- resource group; otherwise, it is not.
--
-- 'outpostArn', 'host_outpostArn' - The Amazon Resource Name (ARN) of the Amazon Web Services Outpost on
-- which the Dedicated Host is allocated.
--
-- 'ownerId', 'host_ownerId' - The ID of the Amazon Web Services account that owns the Dedicated Host.
--
-- 'releaseTime', 'host_releaseTime' - The time that the Dedicated Host was released.
--
-- 'state', 'host_state' - The Dedicated Host\'s state.
--
-- 'tags', 'host_tags' - Any tags assigned to the Dedicated Host.
newHost ::
  Host
newHost :: Host
newHost =
  Host'
    { $sel:allocationTime:Host' :: Maybe ISO8601
allocationTime = forall a. Maybe a
Prelude.Nothing,
      $sel:allowsMultipleInstanceTypes:Host' :: Maybe AllowsMultipleInstanceTypes
allowsMultipleInstanceTypes = forall a. Maybe a
Prelude.Nothing,
      $sel:autoPlacement:Host' :: Maybe AutoPlacement
autoPlacement = forall a. Maybe a
Prelude.Nothing,
      $sel:availabilityZone:Host' :: Maybe Text
availabilityZone = forall a. Maybe a
Prelude.Nothing,
      $sel:availabilityZoneId:Host' :: Maybe Text
availabilityZoneId = forall a. Maybe a
Prelude.Nothing,
      $sel:availableCapacity:Host' :: Maybe AvailableCapacity
availableCapacity = forall a. Maybe a
Prelude.Nothing,
      $sel:clientToken:Host' :: Maybe Text
clientToken = forall a. Maybe a
Prelude.Nothing,
      $sel:hostId:Host' :: Maybe Text
hostId = forall a. Maybe a
Prelude.Nothing,
      $sel:hostProperties:Host' :: Maybe HostProperties
hostProperties = forall a. Maybe a
Prelude.Nothing,
      $sel:hostRecovery:Host' :: Maybe HostRecovery
hostRecovery = forall a. Maybe a
Prelude.Nothing,
      $sel:hostReservationId:Host' :: Maybe Text
hostReservationId = forall a. Maybe a
Prelude.Nothing,
      $sel:instances:Host' :: Maybe [HostInstance]
instances = forall a. Maybe a
Prelude.Nothing,
      $sel:memberOfServiceLinkedResourceGroup:Host' :: Maybe Bool
memberOfServiceLinkedResourceGroup = forall a. Maybe a
Prelude.Nothing,
      $sel:outpostArn:Host' :: Maybe Text
outpostArn = forall a. Maybe a
Prelude.Nothing,
      $sel:ownerId:Host' :: Maybe Text
ownerId = forall a. Maybe a
Prelude.Nothing,
      $sel:releaseTime:Host' :: Maybe ISO8601
releaseTime = forall a. Maybe a
Prelude.Nothing,
      $sel:state:Host' :: Maybe AllocationState
state = forall a. Maybe a
Prelude.Nothing,
      $sel:tags:Host' :: Maybe [Tag]
tags = forall a. Maybe a
Prelude.Nothing
    }

-- | The time that the Dedicated Host was allocated.
host_allocationTime :: Lens.Lens' Host (Prelude.Maybe Prelude.UTCTime)
host_allocationTime :: Lens' Host (Maybe UTCTime)
host_allocationTime = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Host' {Maybe ISO8601
allocationTime :: Maybe ISO8601
$sel:allocationTime:Host' :: Host -> Maybe ISO8601
allocationTime} -> Maybe ISO8601
allocationTime) (\s :: Host
s@Host' {} Maybe ISO8601
a -> Host
s {$sel:allocationTime:Host' :: Maybe ISO8601
allocationTime = Maybe ISO8601
a} :: Host) 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 (a :: Format). Iso' (Time a) UTCTime
Data._Time

-- | Indicates whether the Dedicated Host supports multiple instance types of
-- the same instance family. If the value is @on@, the Dedicated Host
-- supports multiple instance types in the instance family. If the value is
-- @off@, the Dedicated Host supports a single instance type only.
host_allowsMultipleInstanceTypes :: Lens.Lens' Host (Prelude.Maybe AllowsMultipleInstanceTypes)
host_allowsMultipleInstanceTypes :: Lens' Host (Maybe AllowsMultipleInstanceTypes)
host_allowsMultipleInstanceTypes = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Host' {Maybe AllowsMultipleInstanceTypes
allowsMultipleInstanceTypes :: Maybe AllowsMultipleInstanceTypes
$sel:allowsMultipleInstanceTypes:Host' :: Host -> Maybe AllowsMultipleInstanceTypes
allowsMultipleInstanceTypes} -> Maybe AllowsMultipleInstanceTypes
allowsMultipleInstanceTypes) (\s :: Host
s@Host' {} Maybe AllowsMultipleInstanceTypes
a -> Host
s {$sel:allowsMultipleInstanceTypes:Host' :: Maybe AllowsMultipleInstanceTypes
allowsMultipleInstanceTypes = Maybe AllowsMultipleInstanceTypes
a} :: Host)

-- | Whether auto-placement is on or off.
host_autoPlacement :: Lens.Lens' Host (Prelude.Maybe AutoPlacement)
host_autoPlacement :: Lens' Host (Maybe AutoPlacement)
host_autoPlacement = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Host' {Maybe AutoPlacement
autoPlacement :: Maybe AutoPlacement
$sel:autoPlacement:Host' :: Host -> Maybe AutoPlacement
autoPlacement} -> Maybe AutoPlacement
autoPlacement) (\s :: Host
s@Host' {} Maybe AutoPlacement
a -> Host
s {$sel:autoPlacement:Host' :: Maybe AutoPlacement
autoPlacement = Maybe AutoPlacement
a} :: Host)

-- | The Availability Zone of the Dedicated Host.
host_availabilityZone :: Lens.Lens' Host (Prelude.Maybe Prelude.Text)
host_availabilityZone :: Lens' Host (Maybe Text)
host_availabilityZone = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Host' {Maybe Text
availabilityZone :: Maybe Text
$sel:availabilityZone:Host' :: Host -> Maybe Text
availabilityZone} -> Maybe Text
availabilityZone) (\s :: Host
s@Host' {} Maybe Text
a -> Host
s {$sel:availabilityZone:Host' :: Maybe Text
availabilityZone = Maybe Text
a} :: Host)

-- | The ID of the Availability Zone in which the Dedicated Host is
-- allocated.
host_availabilityZoneId :: Lens.Lens' Host (Prelude.Maybe Prelude.Text)
host_availabilityZoneId :: Lens' Host (Maybe Text)
host_availabilityZoneId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Host' {Maybe Text
availabilityZoneId :: Maybe Text
$sel:availabilityZoneId:Host' :: Host -> Maybe Text
availabilityZoneId} -> Maybe Text
availabilityZoneId) (\s :: Host
s@Host' {} Maybe Text
a -> Host
s {$sel:availabilityZoneId:Host' :: Maybe Text
availabilityZoneId = Maybe Text
a} :: Host)

-- | Information about the instances running on the Dedicated Host.
host_availableCapacity :: Lens.Lens' Host (Prelude.Maybe AvailableCapacity)
host_availableCapacity :: Lens' Host (Maybe AvailableCapacity)
host_availableCapacity = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Host' {Maybe AvailableCapacity
availableCapacity :: Maybe AvailableCapacity
$sel:availableCapacity:Host' :: Host -> Maybe AvailableCapacity
availableCapacity} -> Maybe AvailableCapacity
availableCapacity) (\s :: Host
s@Host' {} Maybe AvailableCapacity
a -> Host
s {$sel:availableCapacity:Host' :: Maybe AvailableCapacity
availableCapacity = Maybe AvailableCapacity
a} :: Host)

-- | 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>.
host_clientToken :: Lens.Lens' Host (Prelude.Maybe Prelude.Text)
host_clientToken :: Lens' Host (Maybe Text)
host_clientToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Host' {Maybe Text
clientToken :: Maybe Text
$sel:clientToken:Host' :: Host -> Maybe Text
clientToken} -> Maybe Text
clientToken) (\s :: Host
s@Host' {} Maybe Text
a -> Host
s {$sel:clientToken:Host' :: Maybe Text
clientToken = Maybe Text
a} :: Host)

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

-- | The hardware specifications of the Dedicated Host.
host_hostProperties :: Lens.Lens' Host (Prelude.Maybe HostProperties)
host_hostProperties :: Lens' Host (Maybe HostProperties)
host_hostProperties = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Host' {Maybe HostProperties
hostProperties :: Maybe HostProperties
$sel:hostProperties:Host' :: Host -> Maybe HostProperties
hostProperties} -> Maybe HostProperties
hostProperties) (\s :: Host
s@Host' {} Maybe HostProperties
a -> Host
s {$sel:hostProperties:Host' :: Maybe HostProperties
hostProperties = Maybe HostProperties
a} :: Host)

-- | Indicates whether host recovery is enabled or disabled for the Dedicated
-- Host.
host_hostRecovery :: Lens.Lens' Host (Prelude.Maybe HostRecovery)
host_hostRecovery :: Lens' Host (Maybe HostRecovery)
host_hostRecovery = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Host' {Maybe HostRecovery
hostRecovery :: Maybe HostRecovery
$sel:hostRecovery:Host' :: Host -> Maybe HostRecovery
hostRecovery} -> Maybe HostRecovery
hostRecovery) (\s :: Host
s@Host' {} Maybe HostRecovery
a -> Host
s {$sel:hostRecovery:Host' :: Maybe HostRecovery
hostRecovery = Maybe HostRecovery
a} :: Host)

-- | The reservation ID of the Dedicated Host. This returns a @null@ response
-- if the Dedicated Host doesn\'t have an associated reservation.
host_hostReservationId :: Lens.Lens' Host (Prelude.Maybe Prelude.Text)
host_hostReservationId :: Lens' Host (Maybe Text)
host_hostReservationId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Host' {Maybe Text
hostReservationId :: Maybe Text
$sel:hostReservationId:Host' :: Host -> Maybe Text
hostReservationId} -> Maybe Text
hostReservationId) (\s :: Host
s@Host' {} Maybe Text
a -> Host
s {$sel:hostReservationId:Host' :: Maybe Text
hostReservationId = Maybe Text
a} :: Host)

-- | The IDs and instance type that are currently running on the Dedicated
-- Host.
host_instances :: Lens.Lens' Host (Prelude.Maybe [HostInstance])
host_instances :: Lens' Host (Maybe [HostInstance])
host_instances = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Host' {Maybe [HostInstance]
instances :: Maybe [HostInstance]
$sel:instances:Host' :: Host -> Maybe [HostInstance]
instances} -> Maybe [HostInstance]
instances) (\s :: Host
s@Host' {} Maybe [HostInstance]
a -> Host
s {$sel:instances:Host' :: Maybe [HostInstance]
instances = Maybe [HostInstance]
a} :: Host) 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

-- | Indicates whether the Dedicated Host is in a host resource group. If
-- __memberOfServiceLinkedResourceGroup__ is @true@, the host is in a host
-- resource group; otherwise, it is not.
host_memberOfServiceLinkedResourceGroup :: Lens.Lens' Host (Prelude.Maybe Prelude.Bool)
host_memberOfServiceLinkedResourceGroup :: Lens' Host (Maybe Bool)
host_memberOfServiceLinkedResourceGroup = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Host' {Maybe Bool
memberOfServiceLinkedResourceGroup :: Maybe Bool
$sel:memberOfServiceLinkedResourceGroup:Host' :: Host -> Maybe Bool
memberOfServiceLinkedResourceGroup} -> Maybe Bool
memberOfServiceLinkedResourceGroup) (\s :: Host
s@Host' {} Maybe Bool
a -> Host
s {$sel:memberOfServiceLinkedResourceGroup:Host' :: Maybe Bool
memberOfServiceLinkedResourceGroup = Maybe Bool
a} :: Host)

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

-- | The ID of the Amazon Web Services account that owns the Dedicated Host.
host_ownerId :: Lens.Lens' Host (Prelude.Maybe Prelude.Text)
host_ownerId :: Lens' Host (Maybe Text)
host_ownerId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Host' {Maybe Text
ownerId :: Maybe Text
$sel:ownerId:Host' :: Host -> Maybe Text
ownerId} -> Maybe Text
ownerId) (\s :: Host
s@Host' {} Maybe Text
a -> Host
s {$sel:ownerId:Host' :: Maybe Text
ownerId = Maybe Text
a} :: Host)

-- | The time that the Dedicated Host was released.
host_releaseTime :: Lens.Lens' Host (Prelude.Maybe Prelude.UTCTime)
host_releaseTime :: Lens' Host (Maybe UTCTime)
host_releaseTime = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Host' {Maybe ISO8601
releaseTime :: Maybe ISO8601
$sel:releaseTime:Host' :: Host -> Maybe ISO8601
releaseTime} -> Maybe ISO8601
releaseTime) (\s :: Host
s@Host' {} Maybe ISO8601
a -> Host
s {$sel:releaseTime:Host' :: Maybe ISO8601
releaseTime = Maybe ISO8601
a} :: Host) 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 (a :: Format). Iso' (Time a) UTCTime
Data._Time

-- | The Dedicated Host\'s state.
host_state :: Lens.Lens' Host (Prelude.Maybe AllocationState)
host_state :: Lens' Host (Maybe AllocationState)
host_state = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Host' {Maybe AllocationState
state :: Maybe AllocationState
$sel:state:Host' :: Host -> Maybe AllocationState
state} -> Maybe AllocationState
state) (\s :: Host
s@Host' {} Maybe AllocationState
a -> Host
s {$sel:state:Host' :: Maybe AllocationState
state = Maybe AllocationState
a} :: Host)

-- | Any tags assigned to the Dedicated Host.
host_tags :: Lens.Lens' Host (Prelude.Maybe [Tag])
host_tags :: Lens' Host (Maybe [Tag])
host_tags = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Host' {Maybe [Tag]
tags :: Maybe [Tag]
$sel:tags:Host' :: Host -> Maybe [Tag]
tags} -> Maybe [Tag]
tags) (\s :: Host
s@Host' {} Maybe [Tag]
a -> Host
s {$sel:tags:Host' :: Maybe [Tag]
tags = Maybe [Tag]
a} :: Host) 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

instance Data.FromXML Host where
  parseXML :: [Node] -> Either String Host
parseXML [Node]
x =
    Maybe ISO8601
-> Maybe AllowsMultipleInstanceTypes
-> Maybe AutoPlacement
-> Maybe Text
-> Maybe Text
-> Maybe AvailableCapacity
-> Maybe Text
-> Maybe Text
-> Maybe HostProperties
-> Maybe HostRecovery
-> Maybe Text
-> Maybe [HostInstance]
-> Maybe Bool
-> Maybe Text
-> Maybe Text
-> Maybe ISO8601
-> Maybe AllocationState
-> Maybe [Tag]
-> Host
Host'
      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
"allocationTime")
      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
"allowsMultipleInstanceTypes")
      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
"autoPlacement")
      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
"availabilityZone")
      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
"availabilityZoneId")
      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
"availableCapacity")
      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
"clientToken")
      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
"hostId")
      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
"hostProperties")
      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
"hostRecovery")
      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
"hostReservationId")
      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
"instances"
                      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
"memberOfServiceLinkedResourceGroup")
      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
"outpostArn")
      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
"ownerId")
      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
"releaseTime")
      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
"state")
      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
"tagSet"
                      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")
                  )

instance Prelude.Hashable Host where
  hashWithSalt :: Int -> Host -> Int
hashWithSalt Int
_salt Host' {Maybe Bool
Maybe [HostInstance]
Maybe [Tag]
Maybe Text
Maybe ISO8601
Maybe AllocationState
Maybe AllowsMultipleInstanceTypes
Maybe AutoPlacement
Maybe HostProperties
Maybe HostRecovery
Maybe AvailableCapacity
tags :: Maybe [Tag]
state :: Maybe AllocationState
releaseTime :: Maybe ISO8601
ownerId :: Maybe Text
outpostArn :: Maybe Text
memberOfServiceLinkedResourceGroup :: Maybe Bool
instances :: Maybe [HostInstance]
hostReservationId :: Maybe Text
hostRecovery :: Maybe HostRecovery
hostProperties :: Maybe HostProperties
hostId :: Maybe Text
clientToken :: Maybe Text
availableCapacity :: Maybe AvailableCapacity
availabilityZoneId :: Maybe Text
availabilityZone :: Maybe Text
autoPlacement :: Maybe AutoPlacement
allowsMultipleInstanceTypes :: Maybe AllowsMultipleInstanceTypes
allocationTime :: Maybe ISO8601
$sel:tags:Host' :: Host -> Maybe [Tag]
$sel:state:Host' :: Host -> Maybe AllocationState
$sel:releaseTime:Host' :: Host -> Maybe ISO8601
$sel:ownerId:Host' :: Host -> Maybe Text
$sel:outpostArn:Host' :: Host -> Maybe Text
$sel:memberOfServiceLinkedResourceGroup:Host' :: Host -> Maybe Bool
$sel:instances:Host' :: Host -> Maybe [HostInstance]
$sel:hostReservationId:Host' :: Host -> Maybe Text
$sel:hostRecovery:Host' :: Host -> Maybe HostRecovery
$sel:hostProperties:Host' :: Host -> Maybe HostProperties
$sel:hostId:Host' :: Host -> Maybe Text
$sel:clientToken:Host' :: Host -> Maybe Text
$sel:availableCapacity:Host' :: Host -> Maybe AvailableCapacity
$sel:availabilityZoneId:Host' :: Host -> Maybe Text
$sel:availabilityZone:Host' :: Host -> Maybe Text
$sel:autoPlacement:Host' :: Host -> Maybe AutoPlacement
$sel:allowsMultipleInstanceTypes:Host' :: Host -> Maybe AllowsMultipleInstanceTypes
$sel:allocationTime:Host' :: Host -> Maybe ISO8601
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe ISO8601
allocationTime
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe AllowsMultipleInstanceTypes
allowsMultipleInstanceTypes
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe AutoPlacement
autoPlacement
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
availabilityZone
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
availabilityZoneId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe AvailableCapacity
availableCapacity
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
clientToken
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
hostId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe HostProperties
hostProperties
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe HostRecovery
hostRecovery
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
hostReservationId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [HostInstance]
instances
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Bool
memberOfServiceLinkedResourceGroup
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
outpostArn
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
ownerId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe ISO8601
releaseTime
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe AllocationState
state
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [Tag]
tags

instance Prelude.NFData Host where
  rnf :: Host -> ()
rnf Host' {Maybe Bool
Maybe [HostInstance]
Maybe [Tag]
Maybe Text
Maybe ISO8601
Maybe AllocationState
Maybe AllowsMultipleInstanceTypes
Maybe AutoPlacement
Maybe HostProperties
Maybe HostRecovery
Maybe AvailableCapacity
tags :: Maybe [Tag]
state :: Maybe AllocationState
releaseTime :: Maybe ISO8601
ownerId :: Maybe Text
outpostArn :: Maybe Text
memberOfServiceLinkedResourceGroup :: Maybe Bool
instances :: Maybe [HostInstance]
hostReservationId :: Maybe Text
hostRecovery :: Maybe HostRecovery
hostProperties :: Maybe HostProperties
hostId :: Maybe Text
clientToken :: Maybe Text
availableCapacity :: Maybe AvailableCapacity
availabilityZoneId :: Maybe Text
availabilityZone :: Maybe Text
autoPlacement :: Maybe AutoPlacement
allowsMultipleInstanceTypes :: Maybe AllowsMultipleInstanceTypes
allocationTime :: Maybe ISO8601
$sel:tags:Host' :: Host -> Maybe [Tag]
$sel:state:Host' :: Host -> Maybe AllocationState
$sel:releaseTime:Host' :: Host -> Maybe ISO8601
$sel:ownerId:Host' :: Host -> Maybe Text
$sel:outpostArn:Host' :: Host -> Maybe Text
$sel:memberOfServiceLinkedResourceGroup:Host' :: Host -> Maybe Bool
$sel:instances:Host' :: Host -> Maybe [HostInstance]
$sel:hostReservationId:Host' :: Host -> Maybe Text
$sel:hostRecovery:Host' :: Host -> Maybe HostRecovery
$sel:hostProperties:Host' :: Host -> Maybe HostProperties
$sel:hostId:Host' :: Host -> Maybe Text
$sel:clientToken:Host' :: Host -> Maybe Text
$sel:availableCapacity:Host' :: Host -> Maybe AvailableCapacity
$sel:availabilityZoneId:Host' :: Host -> Maybe Text
$sel:availabilityZone:Host' :: Host -> Maybe Text
$sel:autoPlacement:Host' :: Host -> Maybe AutoPlacement
$sel:allowsMultipleInstanceTypes:Host' :: Host -> Maybe AllowsMultipleInstanceTypes
$sel:allocationTime:Host' :: Host -> Maybe ISO8601
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe ISO8601
allocationTime
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe AllowsMultipleInstanceTypes
allowsMultipleInstanceTypes
      seq :: forall a b. a -> b -> b
`Prelude.seq` 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
availabilityZone
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
availabilityZoneId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe AvailableCapacity
availableCapacity
      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 Text
hostId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe HostProperties
hostProperties
      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
hostReservationId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [HostInstance]
instances
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf
        Maybe Bool
memberOfServiceLinkedResourceGroup
      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 Text
ownerId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe ISO8601
releaseTime
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe AllocationState
state
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [Tag]
tags