{-# 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.CapacityReservation
-- 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.CapacityReservation 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.CapacityAllocation
import Amazonka.EC2.Types.CapacityReservationInstancePlatform
import Amazonka.EC2.Types.CapacityReservationState
import Amazonka.EC2.Types.CapacityReservationTenancy
import Amazonka.EC2.Types.EndDateType
import Amazonka.EC2.Types.InstanceMatchCriteria
import Amazonka.EC2.Types.Tag
import qualified Amazonka.Prelude as Prelude

-- | Describes a Capacity Reservation.
--
-- /See:/ 'newCapacityReservation' smart constructor.
data CapacityReservation = CapacityReservation'
  { -- | The Availability Zone in which the capacity is reserved.
    CapacityReservation -> Maybe Text
availabilityZone :: Prelude.Maybe Prelude.Text,
    -- | The Availability Zone ID of the Capacity Reservation.
    CapacityReservation -> Maybe Text
availabilityZoneId :: Prelude.Maybe Prelude.Text,
    -- | The remaining capacity. Indicates the number of instances that can be
    -- launched in the Capacity Reservation.
    CapacityReservation -> Maybe Int
availableInstanceCount :: Prelude.Maybe Prelude.Int,
    -- | Information about instance capacity usage.
    CapacityReservation -> Maybe [CapacityAllocation]
capacityAllocations :: Prelude.Maybe [CapacityAllocation],
    -- | The Amazon Resource Name (ARN) of the Capacity Reservation.
    CapacityReservation -> Maybe Text
capacityReservationArn :: Prelude.Maybe Prelude.Text,
    -- | The ID of the Capacity Reservation Fleet to which the Capacity
    -- Reservation belongs. Only valid for Capacity Reservations that were
    -- created by a Capacity Reservation Fleet.
    CapacityReservation -> Maybe Text
capacityReservationFleetId :: Prelude.Maybe Prelude.Text,
    -- | The ID of the Capacity Reservation.
    CapacityReservation -> Maybe Text
capacityReservationId :: Prelude.Maybe Prelude.Text,
    -- | The date and time at which the Capacity Reservation was created.
    CapacityReservation -> Maybe ISO8601
createDate :: Prelude.Maybe Data.ISO8601,
    -- | Indicates whether the Capacity Reservation supports EBS-optimized
    -- instances. This optimization provides dedicated throughput to Amazon EBS
    -- and an optimized configuration stack to provide optimal I\/O
    -- performance. This optimization isn\'t available with all instance types.
    -- Additional usage charges apply when using an EBS- optimized instance.
    CapacityReservation -> Maybe Bool
ebsOptimized :: Prelude.Maybe Prelude.Bool,
    -- | The date and time at which the Capacity Reservation expires. When a
    -- Capacity Reservation expires, the reserved capacity is released and you
    -- can no longer launch instances into it. The Capacity Reservation\'s
    -- state changes to @expired@ when it reaches its end date and time.
    CapacityReservation -> Maybe ISO8601
endDate :: Prelude.Maybe Data.ISO8601,
    -- | Indicates the way in which the Capacity Reservation ends. A Capacity
    -- Reservation can have one of the following end types:
    --
    -- -   @unlimited@ - The Capacity Reservation remains active until you
    --     explicitly cancel it.
    --
    -- -   @limited@ - The Capacity Reservation expires automatically at a
    --     specified date and time.
    CapacityReservation -> Maybe EndDateType
endDateType :: Prelude.Maybe EndDateType,
    -- | /Deprecated./
    CapacityReservation -> Maybe Bool
ephemeralStorage :: Prelude.Maybe Prelude.Bool,
    -- | Indicates the type of instance launches that the Capacity Reservation
    -- accepts. The options include:
    --
    -- -   @open@ - The Capacity Reservation accepts all instances that have
    --     matching attributes (instance type, platform, and Availability
    --     Zone). Instances that have matching attributes launch into the
    --     Capacity Reservation automatically without specifying any additional
    --     parameters.
    --
    -- -   @targeted@ - The Capacity Reservation only accepts instances that
    --     have matching attributes (instance type, platform, and Availability
    --     Zone), and explicitly target the Capacity Reservation. This ensures
    --     that only permitted instances can use the reserved capacity.
    CapacityReservation -> Maybe InstanceMatchCriteria
instanceMatchCriteria :: Prelude.Maybe InstanceMatchCriteria,
    -- | The type of operating system for which the Capacity Reservation reserves
    -- capacity.
    CapacityReservation -> Maybe CapacityReservationInstancePlatform
instancePlatform :: Prelude.Maybe CapacityReservationInstancePlatform,
    -- | The type of instance for which the Capacity Reservation reserves
    -- capacity.
    CapacityReservation -> Maybe Text
instanceType :: Prelude.Maybe Prelude.Text,
    -- | The Amazon Resource Name (ARN) of the Outpost on which the Capacity
    -- Reservation was created.
    CapacityReservation -> Maybe Text
outpostArn :: Prelude.Maybe Prelude.Text,
    -- | The ID of the Amazon Web Services account that owns the Capacity
    -- Reservation.
    CapacityReservation -> Maybe Text
ownerId :: Prelude.Maybe Prelude.Text,
    -- | The Amazon Resource Name (ARN) of the cluster placement group in which
    -- the Capacity Reservation was created. For more information, see
    -- <https://docs.aws.amazon.com/AWSEC2/latest/UserGuide/cr-cpg.html Capacity Reservations for cluster placement groups>
    -- in the /Amazon EC2 User Guide/.
    CapacityReservation -> Maybe Text
placementGroupArn :: Prelude.Maybe Prelude.Text,
    -- | The date and time at which the Capacity Reservation was started.
    CapacityReservation -> Maybe ISO8601
startDate :: Prelude.Maybe Data.ISO8601,
    -- | The current state of the Capacity Reservation. A Capacity Reservation
    -- can be in one of the following states:
    --
    -- -   @active@ - The Capacity Reservation is active and the capacity is
    --     available for your use.
    --
    -- -   @expired@ - The Capacity Reservation expired automatically at the
    --     date and time specified in your request. The reserved capacity is no
    --     longer available for your use.
    --
    -- -   @cancelled@ - The Capacity Reservation was cancelled. The reserved
    --     capacity is no longer available for your use.
    --
    -- -   @pending@ - The Capacity Reservation request was successful but the
    --     capacity provisioning is still pending.
    --
    -- -   @failed@ - The Capacity Reservation request has failed. A request
    --     might fail due to invalid request parameters, capacity constraints,
    --     or instance limit constraints. Failed requests are retained for 60
    --     minutes.
    CapacityReservation -> Maybe CapacityReservationState
state :: Prelude.Maybe CapacityReservationState,
    -- | Any tags assigned to the Capacity Reservation.
    CapacityReservation -> Maybe [Tag]
tags :: Prelude.Maybe [Tag],
    -- | Indicates the tenancy of the Capacity Reservation. A Capacity
    -- Reservation can have one of the following tenancy settings:
    --
    -- -   @default@ - The Capacity Reservation is created on hardware that is
    --     shared with other Amazon Web Services accounts.
    --
    -- -   @dedicated@ - The Capacity Reservation is created on single-tenant
    --     hardware that is dedicated to a single Amazon Web Services account.
    CapacityReservation -> Maybe CapacityReservationTenancy
tenancy :: Prelude.Maybe CapacityReservationTenancy,
    -- | The total number of instances for which the Capacity Reservation
    -- reserves capacity.
    CapacityReservation -> Maybe Int
totalInstanceCount :: Prelude.Maybe Prelude.Int
  }
  deriving (CapacityReservation -> CapacityReservation -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CapacityReservation -> CapacityReservation -> Bool
$c/= :: CapacityReservation -> CapacityReservation -> Bool
== :: CapacityReservation -> CapacityReservation -> Bool
$c== :: CapacityReservation -> CapacityReservation -> Bool
Prelude.Eq, ReadPrec [CapacityReservation]
ReadPrec CapacityReservation
Int -> ReadS CapacityReservation
ReadS [CapacityReservation]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CapacityReservation]
$creadListPrec :: ReadPrec [CapacityReservation]
readPrec :: ReadPrec CapacityReservation
$creadPrec :: ReadPrec CapacityReservation
readList :: ReadS [CapacityReservation]
$creadList :: ReadS [CapacityReservation]
readsPrec :: Int -> ReadS CapacityReservation
$creadsPrec :: Int -> ReadS CapacityReservation
Prelude.Read, Int -> CapacityReservation -> ShowS
[CapacityReservation] -> ShowS
CapacityReservation -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CapacityReservation] -> ShowS
$cshowList :: [CapacityReservation] -> ShowS
show :: CapacityReservation -> String
$cshow :: CapacityReservation -> String
showsPrec :: Int -> CapacityReservation -> ShowS
$cshowsPrec :: Int -> CapacityReservation -> ShowS
Prelude.Show, forall x. Rep CapacityReservation x -> CapacityReservation
forall x. CapacityReservation -> Rep CapacityReservation x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CapacityReservation x -> CapacityReservation
$cfrom :: forall x. CapacityReservation -> Rep CapacityReservation x
Prelude.Generic)

-- |
-- Create a value of 'CapacityReservation' 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:
--
-- 'availabilityZone', 'capacityReservation_availabilityZone' - The Availability Zone in which the capacity is reserved.
--
-- 'availabilityZoneId', 'capacityReservation_availabilityZoneId' - The Availability Zone ID of the Capacity Reservation.
--
-- 'availableInstanceCount', 'capacityReservation_availableInstanceCount' - The remaining capacity. Indicates the number of instances that can be
-- launched in the Capacity Reservation.
--
-- 'capacityAllocations', 'capacityReservation_capacityAllocations' - Information about instance capacity usage.
--
-- 'capacityReservationArn', 'capacityReservation_capacityReservationArn' - The Amazon Resource Name (ARN) of the Capacity Reservation.
--
-- 'capacityReservationFleetId', 'capacityReservation_capacityReservationFleetId' - The ID of the Capacity Reservation Fleet to which the Capacity
-- Reservation belongs. Only valid for Capacity Reservations that were
-- created by a Capacity Reservation Fleet.
--
-- 'capacityReservationId', 'capacityReservation_capacityReservationId' - The ID of the Capacity Reservation.
--
-- 'createDate', 'capacityReservation_createDate' - The date and time at which the Capacity Reservation was created.
--
-- 'ebsOptimized', 'capacityReservation_ebsOptimized' - Indicates whether the Capacity Reservation supports EBS-optimized
-- instances. This optimization provides dedicated throughput to Amazon EBS
-- and an optimized configuration stack to provide optimal I\/O
-- performance. This optimization isn\'t available with all instance types.
-- Additional usage charges apply when using an EBS- optimized instance.
--
-- 'endDate', 'capacityReservation_endDate' - The date and time at which the Capacity Reservation expires. When a
-- Capacity Reservation expires, the reserved capacity is released and you
-- can no longer launch instances into it. The Capacity Reservation\'s
-- state changes to @expired@ when it reaches its end date and time.
--
-- 'endDateType', 'capacityReservation_endDateType' - Indicates the way in which the Capacity Reservation ends. A Capacity
-- Reservation can have one of the following end types:
--
-- -   @unlimited@ - The Capacity Reservation remains active until you
--     explicitly cancel it.
--
-- -   @limited@ - The Capacity Reservation expires automatically at a
--     specified date and time.
--
-- 'ephemeralStorage', 'capacityReservation_ephemeralStorage' - /Deprecated./
--
-- 'instanceMatchCriteria', 'capacityReservation_instanceMatchCriteria' - Indicates the type of instance launches that the Capacity Reservation
-- accepts. The options include:
--
-- -   @open@ - The Capacity Reservation accepts all instances that have
--     matching attributes (instance type, platform, and Availability
--     Zone). Instances that have matching attributes launch into the
--     Capacity Reservation automatically without specifying any additional
--     parameters.
--
-- -   @targeted@ - The Capacity Reservation only accepts instances that
--     have matching attributes (instance type, platform, and Availability
--     Zone), and explicitly target the Capacity Reservation. This ensures
--     that only permitted instances can use the reserved capacity.
--
-- 'instancePlatform', 'capacityReservation_instancePlatform' - The type of operating system for which the Capacity Reservation reserves
-- capacity.
--
-- 'instanceType', 'capacityReservation_instanceType' - The type of instance for which the Capacity Reservation reserves
-- capacity.
--
-- 'outpostArn', 'capacityReservation_outpostArn' - The Amazon Resource Name (ARN) of the Outpost on which the Capacity
-- Reservation was created.
--
-- 'ownerId', 'capacityReservation_ownerId' - The ID of the Amazon Web Services account that owns the Capacity
-- Reservation.
--
-- 'placementGroupArn', 'capacityReservation_placementGroupArn' - The Amazon Resource Name (ARN) of the cluster placement group in which
-- the Capacity Reservation was created. For more information, see
-- <https://docs.aws.amazon.com/AWSEC2/latest/UserGuide/cr-cpg.html Capacity Reservations for cluster placement groups>
-- in the /Amazon EC2 User Guide/.
--
-- 'startDate', 'capacityReservation_startDate' - The date and time at which the Capacity Reservation was started.
--
-- 'state', 'capacityReservation_state' - The current state of the Capacity Reservation. A Capacity Reservation
-- can be in one of the following states:
--
-- -   @active@ - The Capacity Reservation is active and the capacity is
--     available for your use.
--
-- -   @expired@ - The Capacity Reservation expired automatically at the
--     date and time specified in your request. The reserved capacity is no
--     longer available for your use.
--
-- -   @cancelled@ - The Capacity Reservation was cancelled. The reserved
--     capacity is no longer available for your use.
--
-- -   @pending@ - The Capacity Reservation request was successful but the
--     capacity provisioning is still pending.
--
-- -   @failed@ - The Capacity Reservation request has failed. A request
--     might fail due to invalid request parameters, capacity constraints,
--     or instance limit constraints. Failed requests are retained for 60
--     minutes.
--
-- 'tags', 'capacityReservation_tags' - Any tags assigned to the Capacity Reservation.
--
-- 'tenancy', 'capacityReservation_tenancy' - Indicates the tenancy of the Capacity Reservation. A Capacity
-- Reservation can have one of the following tenancy settings:
--
-- -   @default@ - The Capacity Reservation is created on hardware that is
--     shared with other Amazon Web Services accounts.
--
-- -   @dedicated@ - The Capacity Reservation is created on single-tenant
--     hardware that is dedicated to a single Amazon Web Services account.
--
-- 'totalInstanceCount', 'capacityReservation_totalInstanceCount' - The total number of instances for which the Capacity Reservation
-- reserves capacity.
newCapacityReservation ::
  CapacityReservation
newCapacityReservation :: CapacityReservation
newCapacityReservation =
  CapacityReservation'
    { $sel:availabilityZone:CapacityReservation' :: Maybe Text
availabilityZone =
        forall a. Maybe a
Prelude.Nothing,
      $sel:availabilityZoneId:CapacityReservation' :: Maybe Text
availabilityZoneId = forall a. Maybe a
Prelude.Nothing,
      $sel:availableInstanceCount:CapacityReservation' :: Maybe Int
availableInstanceCount = forall a. Maybe a
Prelude.Nothing,
      $sel:capacityAllocations:CapacityReservation' :: Maybe [CapacityAllocation]
capacityAllocations = forall a. Maybe a
Prelude.Nothing,
      $sel:capacityReservationArn:CapacityReservation' :: Maybe Text
capacityReservationArn = forall a. Maybe a
Prelude.Nothing,
      $sel:capacityReservationFleetId:CapacityReservation' :: Maybe Text
capacityReservationFleetId = forall a. Maybe a
Prelude.Nothing,
      $sel:capacityReservationId:CapacityReservation' :: Maybe Text
capacityReservationId = forall a. Maybe a
Prelude.Nothing,
      $sel:createDate:CapacityReservation' :: Maybe ISO8601
createDate = forall a. Maybe a
Prelude.Nothing,
      $sel:ebsOptimized:CapacityReservation' :: Maybe Bool
ebsOptimized = forall a. Maybe a
Prelude.Nothing,
      $sel:endDate:CapacityReservation' :: Maybe ISO8601
endDate = forall a. Maybe a
Prelude.Nothing,
      $sel:endDateType:CapacityReservation' :: Maybe EndDateType
endDateType = forall a. Maybe a
Prelude.Nothing,
      $sel:ephemeralStorage:CapacityReservation' :: Maybe Bool
ephemeralStorage = forall a. Maybe a
Prelude.Nothing,
      $sel:instanceMatchCriteria:CapacityReservation' :: Maybe InstanceMatchCriteria
instanceMatchCriteria = forall a. Maybe a
Prelude.Nothing,
      $sel:instancePlatform:CapacityReservation' :: Maybe CapacityReservationInstancePlatform
instancePlatform = forall a. Maybe a
Prelude.Nothing,
      $sel:instanceType:CapacityReservation' :: Maybe Text
instanceType = forall a. Maybe a
Prelude.Nothing,
      $sel:outpostArn:CapacityReservation' :: Maybe Text
outpostArn = forall a. Maybe a
Prelude.Nothing,
      $sel:ownerId:CapacityReservation' :: Maybe Text
ownerId = forall a. Maybe a
Prelude.Nothing,
      $sel:placementGroupArn:CapacityReservation' :: Maybe Text
placementGroupArn = forall a. Maybe a
Prelude.Nothing,
      $sel:startDate:CapacityReservation' :: Maybe ISO8601
startDate = forall a. Maybe a
Prelude.Nothing,
      $sel:state:CapacityReservation' :: Maybe CapacityReservationState
state = forall a. Maybe a
Prelude.Nothing,
      $sel:tags:CapacityReservation' :: Maybe [Tag]
tags = forall a. Maybe a
Prelude.Nothing,
      $sel:tenancy:CapacityReservation' :: Maybe CapacityReservationTenancy
tenancy = forall a. Maybe a
Prelude.Nothing,
      $sel:totalInstanceCount:CapacityReservation' :: Maybe Int
totalInstanceCount = forall a. Maybe a
Prelude.Nothing
    }

-- | The Availability Zone in which the capacity is reserved.
capacityReservation_availabilityZone :: Lens.Lens' CapacityReservation (Prelude.Maybe Prelude.Text)
capacityReservation_availabilityZone :: Lens' CapacityReservation (Maybe Text)
capacityReservation_availabilityZone = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CapacityReservation' {Maybe Text
availabilityZone :: Maybe Text
$sel:availabilityZone:CapacityReservation' :: CapacityReservation -> Maybe Text
availabilityZone} -> Maybe Text
availabilityZone) (\s :: CapacityReservation
s@CapacityReservation' {} Maybe Text
a -> CapacityReservation
s {$sel:availabilityZone:CapacityReservation' :: Maybe Text
availabilityZone = Maybe Text
a} :: CapacityReservation)

-- | The Availability Zone ID of the Capacity Reservation.
capacityReservation_availabilityZoneId :: Lens.Lens' CapacityReservation (Prelude.Maybe Prelude.Text)
capacityReservation_availabilityZoneId :: Lens' CapacityReservation (Maybe Text)
capacityReservation_availabilityZoneId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CapacityReservation' {Maybe Text
availabilityZoneId :: Maybe Text
$sel:availabilityZoneId:CapacityReservation' :: CapacityReservation -> Maybe Text
availabilityZoneId} -> Maybe Text
availabilityZoneId) (\s :: CapacityReservation
s@CapacityReservation' {} Maybe Text
a -> CapacityReservation
s {$sel:availabilityZoneId:CapacityReservation' :: Maybe Text
availabilityZoneId = Maybe Text
a} :: CapacityReservation)

-- | The remaining capacity. Indicates the number of instances that can be
-- launched in the Capacity Reservation.
capacityReservation_availableInstanceCount :: Lens.Lens' CapacityReservation (Prelude.Maybe Prelude.Int)
capacityReservation_availableInstanceCount :: Lens' CapacityReservation (Maybe Int)
capacityReservation_availableInstanceCount = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CapacityReservation' {Maybe Int
availableInstanceCount :: Maybe Int
$sel:availableInstanceCount:CapacityReservation' :: CapacityReservation -> Maybe Int
availableInstanceCount} -> Maybe Int
availableInstanceCount) (\s :: CapacityReservation
s@CapacityReservation' {} Maybe Int
a -> CapacityReservation
s {$sel:availableInstanceCount:CapacityReservation' :: Maybe Int
availableInstanceCount = Maybe Int
a} :: CapacityReservation)

-- | Information about instance capacity usage.
capacityReservation_capacityAllocations :: Lens.Lens' CapacityReservation (Prelude.Maybe [CapacityAllocation])
capacityReservation_capacityAllocations :: Lens' CapacityReservation (Maybe [CapacityAllocation])
capacityReservation_capacityAllocations = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CapacityReservation' {Maybe [CapacityAllocation]
capacityAllocations :: Maybe [CapacityAllocation]
$sel:capacityAllocations:CapacityReservation' :: CapacityReservation -> Maybe [CapacityAllocation]
capacityAllocations} -> Maybe [CapacityAllocation]
capacityAllocations) (\s :: CapacityReservation
s@CapacityReservation' {} Maybe [CapacityAllocation]
a -> CapacityReservation
s {$sel:capacityAllocations:CapacityReservation' :: Maybe [CapacityAllocation]
capacityAllocations = Maybe [CapacityAllocation]
a} :: CapacityReservation) 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 Amazon Resource Name (ARN) of the Capacity Reservation.
capacityReservation_capacityReservationArn :: Lens.Lens' CapacityReservation (Prelude.Maybe Prelude.Text)
capacityReservation_capacityReservationArn :: Lens' CapacityReservation (Maybe Text)
capacityReservation_capacityReservationArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CapacityReservation' {Maybe Text
capacityReservationArn :: Maybe Text
$sel:capacityReservationArn:CapacityReservation' :: CapacityReservation -> Maybe Text
capacityReservationArn} -> Maybe Text
capacityReservationArn) (\s :: CapacityReservation
s@CapacityReservation' {} Maybe Text
a -> CapacityReservation
s {$sel:capacityReservationArn:CapacityReservation' :: Maybe Text
capacityReservationArn = Maybe Text
a} :: CapacityReservation)

-- | The ID of the Capacity Reservation Fleet to which the Capacity
-- Reservation belongs. Only valid for Capacity Reservations that were
-- created by a Capacity Reservation Fleet.
capacityReservation_capacityReservationFleetId :: Lens.Lens' CapacityReservation (Prelude.Maybe Prelude.Text)
capacityReservation_capacityReservationFleetId :: Lens' CapacityReservation (Maybe Text)
capacityReservation_capacityReservationFleetId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CapacityReservation' {Maybe Text
capacityReservationFleetId :: Maybe Text
$sel:capacityReservationFleetId:CapacityReservation' :: CapacityReservation -> Maybe Text
capacityReservationFleetId} -> Maybe Text
capacityReservationFleetId) (\s :: CapacityReservation
s@CapacityReservation' {} Maybe Text
a -> CapacityReservation
s {$sel:capacityReservationFleetId:CapacityReservation' :: Maybe Text
capacityReservationFleetId = Maybe Text
a} :: CapacityReservation)

-- | The ID of the Capacity Reservation.
capacityReservation_capacityReservationId :: Lens.Lens' CapacityReservation (Prelude.Maybe Prelude.Text)
capacityReservation_capacityReservationId :: Lens' CapacityReservation (Maybe Text)
capacityReservation_capacityReservationId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CapacityReservation' {Maybe Text
capacityReservationId :: Maybe Text
$sel:capacityReservationId:CapacityReservation' :: CapacityReservation -> Maybe Text
capacityReservationId} -> Maybe Text
capacityReservationId) (\s :: CapacityReservation
s@CapacityReservation' {} Maybe Text
a -> CapacityReservation
s {$sel:capacityReservationId:CapacityReservation' :: Maybe Text
capacityReservationId = Maybe Text
a} :: CapacityReservation)

-- | The date and time at which the Capacity Reservation was created.
capacityReservation_createDate :: Lens.Lens' CapacityReservation (Prelude.Maybe Prelude.UTCTime)
capacityReservation_createDate :: Lens' CapacityReservation (Maybe UTCTime)
capacityReservation_createDate = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CapacityReservation' {Maybe ISO8601
createDate :: Maybe ISO8601
$sel:createDate:CapacityReservation' :: CapacityReservation -> Maybe ISO8601
createDate} -> Maybe ISO8601
createDate) (\s :: CapacityReservation
s@CapacityReservation' {} Maybe ISO8601
a -> CapacityReservation
s {$sel:createDate:CapacityReservation' :: Maybe ISO8601
createDate = Maybe ISO8601
a} :: CapacityReservation) 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 Capacity Reservation supports EBS-optimized
-- instances. This optimization provides dedicated throughput to Amazon EBS
-- and an optimized configuration stack to provide optimal I\/O
-- performance. This optimization isn\'t available with all instance types.
-- Additional usage charges apply when using an EBS- optimized instance.
capacityReservation_ebsOptimized :: Lens.Lens' CapacityReservation (Prelude.Maybe Prelude.Bool)
capacityReservation_ebsOptimized :: Lens' CapacityReservation (Maybe Bool)
capacityReservation_ebsOptimized = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CapacityReservation' {Maybe Bool
ebsOptimized :: Maybe Bool
$sel:ebsOptimized:CapacityReservation' :: CapacityReservation -> Maybe Bool
ebsOptimized} -> Maybe Bool
ebsOptimized) (\s :: CapacityReservation
s@CapacityReservation' {} Maybe Bool
a -> CapacityReservation
s {$sel:ebsOptimized:CapacityReservation' :: Maybe Bool
ebsOptimized = Maybe Bool
a} :: CapacityReservation)

-- | The date and time at which the Capacity Reservation expires. When a
-- Capacity Reservation expires, the reserved capacity is released and you
-- can no longer launch instances into it. The Capacity Reservation\'s
-- state changes to @expired@ when it reaches its end date and time.
capacityReservation_endDate :: Lens.Lens' CapacityReservation (Prelude.Maybe Prelude.UTCTime)
capacityReservation_endDate :: Lens' CapacityReservation (Maybe UTCTime)
capacityReservation_endDate = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CapacityReservation' {Maybe ISO8601
endDate :: Maybe ISO8601
$sel:endDate:CapacityReservation' :: CapacityReservation -> Maybe ISO8601
endDate} -> Maybe ISO8601
endDate) (\s :: CapacityReservation
s@CapacityReservation' {} Maybe ISO8601
a -> CapacityReservation
s {$sel:endDate:CapacityReservation' :: Maybe ISO8601
endDate = Maybe ISO8601
a} :: CapacityReservation) 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 the way in which the Capacity Reservation ends. A Capacity
-- Reservation can have one of the following end types:
--
-- -   @unlimited@ - The Capacity Reservation remains active until you
--     explicitly cancel it.
--
-- -   @limited@ - The Capacity Reservation expires automatically at a
--     specified date and time.
capacityReservation_endDateType :: Lens.Lens' CapacityReservation (Prelude.Maybe EndDateType)
capacityReservation_endDateType :: Lens' CapacityReservation (Maybe EndDateType)
capacityReservation_endDateType = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CapacityReservation' {Maybe EndDateType
endDateType :: Maybe EndDateType
$sel:endDateType:CapacityReservation' :: CapacityReservation -> Maybe EndDateType
endDateType} -> Maybe EndDateType
endDateType) (\s :: CapacityReservation
s@CapacityReservation' {} Maybe EndDateType
a -> CapacityReservation
s {$sel:endDateType:CapacityReservation' :: Maybe EndDateType
endDateType = Maybe EndDateType
a} :: CapacityReservation)

-- | /Deprecated./
capacityReservation_ephemeralStorage :: Lens.Lens' CapacityReservation (Prelude.Maybe Prelude.Bool)
capacityReservation_ephemeralStorage :: Lens' CapacityReservation (Maybe Bool)
capacityReservation_ephemeralStorage = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CapacityReservation' {Maybe Bool
ephemeralStorage :: Maybe Bool
$sel:ephemeralStorage:CapacityReservation' :: CapacityReservation -> Maybe Bool
ephemeralStorage} -> Maybe Bool
ephemeralStorage) (\s :: CapacityReservation
s@CapacityReservation' {} Maybe Bool
a -> CapacityReservation
s {$sel:ephemeralStorage:CapacityReservation' :: Maybe Bool
ephemeralStorage = Maybe Bool
a} :: CapacityReservation)

-- | Indicates the type of instance launches that the Capacity Reservation
-- accepts. The options include:
--
-- -   @open@ - The Capacity Reservation accepts all instances that have
--     matching attributes (instance type, platform, and Availability
--     Zone). Instances that have matching attributes launch into the
--     Capacity Reservation automatically without specifying any additional
--     parameters.
--
-- -   @targeted@ - The Capacity Reservation only accepts instances that
--     have matching attributes (instance type, platform, and Availability
--     Zone), and explicitly target the Capacity Reservation. This ensures
--     that only permitted instances can use the reserved capacity.
capacityReservation_instanceMatchCriteria :: Lens.Lens' CapacityReservation (Prelude.Maybe InstanceMatchCriteria)
capacityReservation_instanceMatchCriteria :: Lens' CapacityReservation (Maybe InstanceMatchCriteria)
capacityReservation_instanceMatchCriteria = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CapacityReservation' {Maybe InstanceMatchCriteria
instanceMatchCriteria :: Maybe InstanceMatchCriteria
$sel:instanceMatchCriteria:CapacityReservation' :: CapacityReservation -> Maybe InstanceMatchCriteria
instanceMatchCriteria} -> Maybe InstanceMatchCriteria
instanceMatchCriteria) (\s :: CapacityReservation
s@CapacityReservation' {} Maybe InstanceMatchCriteria
a -> CapacityReservation
s {$sel:instanceMatchCriteria:CapacityReservation' :: Maybe InstanceMatchCriteria
instanceMatchCriteria = Maybe InstanceMatchCriteria
a} :: CapacityReservation)

-- | The type of operating system for which the Capacity Reservation reserves
-- capacity.
capacityReservation_instancePlatform :: Lens.Lens' CapacityReservation (Prelude.Maybe CapacityReservationInstancePlatform)
capacityReservation_instancePlatform :: Lens'
  CapacityReservation (Maybe CapacityReservationInstancePlatform)
capacityReservation_instancePlatform = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CapacityReservation' {Maybe CapacityReservationInstancePlatform
instancePlatform :: Maybe CapacityReservationInstancePlatform
$sel:instancePlatform:CapacityReservation' :: CapacityReservation -> Maybe CapacityReservationInstancePlatform
instancePlatform} -> Maybe CapacityReservationInstancePlatform
instancePlatform) (\s :: CapacityReservation
s@CapacityReservation' {} Maybe CapacityReservationInstancePlatform
a -> CapacityReservation
s {$sel:instancePlatform:CapacityReservation' :: Maybe CapacityReservationInstancePlatform
instancePlatform = Maybe CapacityReservationInstancePlatform
a} :: CapacityReservation)

-- | The type of instance for which the Capacity Reservation reserves
-- capacity.
capacityReservation_instanceType :: Lens.Lens' CapacityReservation (Prelude.Maybe Prelude.Text)
capacityReservation_instanceType :: Lens' CapacityReservation (Maybe Text)
capacityReservation_instanceType = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CapacityReservation' {Maybe Text
instanceType :: Maybe Text
$sel:instanceType:CapacityReservation' :: CapacityReservation -> Maybe Text
instanceType} -> Maybe Text
instanceType) (\s :: CapacityReservation
s@CapacityReservation' {} Maybe Text
a -> CapacityReservation
s {$sel:instanceType:CapacityReservation' :: Maybe Text
instanceType = Maybe Text
a} :: CapacityReservation)

-- | The Amazon Resource Name (ARN) of the Outpost on which the Capacity
-- Reservation was created.
capacityReservation_outpostArn :: Lens.Lens' CapacityReservation (Prelude.Maybe Prelude.Text)
capacityReservation_outpostArn :: Lens' CapacityReservation (Maybe Text)
capacityReservation_outpostArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CapacityReservation' {Maybe Text
outpostArn :: Maybe Text
$sel:outpostArn:CapacityReservation' :: CapacityReservation -> Maybe Text
outpostArn} -> Maybe Text
outpostArn) (\s :: CapacityReservation
s@CapacityReservation' {} Maybe Text
a -> CapacityReservation
s {$sel:outpostArn:CapacityReservation' :: Maybe Text
outpostArn = Maybe Text
a} :: CapacityReservation)

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

-- | The Amazon Resource Name (ARN) of the cluster placement group in which
-- the Capacity Reservation was created. For more information, see
-- <https://docs.aws.amazon.com/AWSEC2/latest/UserGuide/cr-cpg.html Capacity Reservations for cluster placement groups>
-- in the /Amazon EC2 User Guide/.
capacityReservation_placementGroupArn :: Lens.Lens' CapacityReservation (Prelude.Maybe Prelude.Text)
capacityReservation_placementGroupArn :: Lens' CapacityReservation (Maybe Text)
capacityReservation_placementGroupArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CapacityReservation' {Maybe Text
placementGroupArn :: Maybe Text
$sel:placementGroupArn:CapacityReservation' :: CapacityReservation -> Maybe Text
placementGroupArn} -> Maybe Text
placementGroupArn) (\s :: CapacityReservation
s@CapacityReservation' {} Maybe Text
a -> CapacityReservation
s {$sel:placementGroupArn:CapacityReservation' :: Maybe Text
placementGroupArn = Maybe Text
a} :: CapacityReservation)

-- | The date and time at which the Capacity Reservation was started.
capacityReservation_startDate :: Lens.Lens' CapacityReservation (Prelude.Maybe Prelude.UTCTime)
capacityReservation_startDate :: Lens' CapacityReservation (Maybe UTCTime)
capacityReservation_startDate = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CapacityReservation' {Maybe ISO8601
startDate :: Maybe ISO8601
$sel:startDate:CapacityReservation' :: CapacityReservation -> Maybe ISO8601
startDate} -> Maybe ISO8601
startDate) (\s :: CapacityReservation
s@CapacityReservation' {} Maybe ISO8601
a -> CapacityReservation
s {$sel:startDate:CapacityReservation' :: Maybe ISO8601
startDate = Maybe ISO8601
a} :: CapacityReservation) 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 current state of the Capacity Reservation. A Capacity Reservation
-- can be in one of the following states:
--
-- -   @active@ - The Capacity Reservation is active and the capacity is
--     available for your use.
--
-- -   @expired@ - The Capacity Reservation expired automatically at the
--     date and time specified in your request. The reserved capacity is no
--     longer available for your use.
--
-- -   @cancelled@ - The Capacity Reservation was cancelled. The reserved
--     capacity is no longer available for your use.
--
-- -   @pending@ - The Capacity Reservation request was successful but the
--     capacity provisioning is still pending.
--
-- -   @failed@ - The Capacity Reservation request has failed. A request
--     might fail due to invalid request parameters, capacity constraints,
--     or instance limit constraints. Failed requests are retained for 60
--     minutes.
capacityReservation_state :: Lens.Lens' CapacityReservation (Prelude.Maybe CapacityReservationState)
capacityReservation_state :: Lens' CapacityReservation (Maybe CapacityReservationState)
capacityReservation_state = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CapacityReservation' {Maybe CapacityReservationState
state :: Maybe CapacityReservationState
$sel:state:CapacityReservation' :: CapacityReservation -> Maybe CapacityReservationState
state} -> Maybe CapacityReservationState
state) (\s :: CapacityReservation
s@CapacityReservation' {} Maybe CapacityReservationState
a -> CapacityReservation
s {$sel:state:CapacityReservation' :: Maybe CapacityReservationState
state = Maybe CapacityReservationState
a} :: CapacityReservation)

-- | Any tags assigned to the Capacity Reservation.
capacityReservation_tags :: Lens.Lens' CapacityReservation (Prelude.Maybe [Tag])
capacityReservation_tags :: Lens' CapacityReservation (Maybe [Tag])
capacityReservation_tags = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CapacityReservation' {Maybe [Tag]
tags :: Maybe [Tag]
$sel:tags:CapacityReservation' :: CapacityReservation -> Maybe [Tag]
tags} -> Maybe [Tag]
tags) (\s :: CapacityReservation
s@CapacityReservation' {} Maybe [Tag]
a -> CapacityReservation
s {$sel:tags:CapacityReservation' :: Maybe [Tag]
tags = Maybe [Tag]
a} :: CapacityReservation) 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 the tenancy of the Capacity Reservation. A Capacity
-- Reservation can have one of the following tenancy settings:
--
-- -   @default@ - The Capacity Reservation is created on hardware that is
--     shared with other Amazon Web Services accounts.
--
-- -   @dedicated@ - The Capacity Reservation is created on single-tenant
--     hardware that is dedicated to a single Amazon Web Services account.
capacityReservation_tenancy :: Lens.Lens' CapacityReservation (Prelude.Maybe CapacityReservationTenancy)
capacityReservation_tenancy :: Lens' CapacityReservation (Maybe CapacityReservationTenancy)
capacityReservation_tenancy = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CapacityReservation' {Maybe CapacityReservationTenancy
tenancy :: Maybe CapacityReservationTenancy
$sel:tenancy:CapacityReservation' :: CapacityReservation -> Maybe CapacityReservationTenancy
tenancy} -> Maybe CapacityReservationTenancy
tenancy) (\s :: CapacityReservation
s@CapacityReservation' {} Maybe CapacityReservationTenancy
a -> CapacityReservation
s {$sel:tenancy:CapacityReservation' :: Maybe CapacityReservationTenancy
tenancy = Maybe CapacityReservationTenancy
a} :: CapacityReservation)

-- | The total number of instances for which the Capacity Reservation
-- reserves capacity.
capacityReservation_totalInstanceCount :: Lens.Lens' CapacityReservation (Prelude.Maybe Prelude.Int)
capacityReservation_totalInstanceCount :: Lens' CapacityReservation (Maybe Int)
capacityReservation_totalInstanceCount = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CapacityReservation' {Maybe Int
totalInstanceCount :: Maybe Int
$sel:totalInstanceCount:CapacityReservation' :: CapacityReservation -> Maybe Int
totalInstanceCount} -> Maybe Int
totalInstanceCount) (\s :: CapacityReservation
s@CapacityReservation' {} Maybe Int
a -> CapacityReservation
s {$sel:totalInstanceCount:CapacityReservation' :: Maybe Int
totalInstanceCount = Maybe Int
a} :: CapacityReservation)

instance Data.FromXML CapacityReservation where
  parseXML :: [Node] -> Either String CapacityReservation
parseXML [Node]
x =
    Maybe Text
-> Maybe Text
-> Maybe Int
-> Maybe [CapacityAllocation]
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe ISO8601
-> Maybe Bool
-> Maybe ISO8601
-> Maybe EndDateType
-> Maybe Bool
-> Maybe InstanceMatchCriteria
-> Maybe CapacityReservationInstancePlatform
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe ISO8601
-> Maybe CapacityReservationState
-> Maybe [Tag]
-> Maybe CapacityReservationTenancy
-> Maybe Int
-> CapacityReservation
CapacityReservation'
      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
"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
"availableInstanceCount")
      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
"capacityAllocationSet"
                      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
"capacityReservationArn")
      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
"capacityReservationFleetId")
      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
"capacityReservationId")
      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
"createDate")
      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
"ebsOptimized")
      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
"endDate")
      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
"endDateType")
      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
"ephemeralStorage")
      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
"instanceMatchCriteria")
      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
"instancePlatform")
      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
"instanceType")
      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
"placementGroupArn")
      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
"startDate")
      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")
                  )
      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
"tenancy")
      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
"totalInstanceCount")

instance Prelude.Hashable CapacityReservation where
  hashWithSalt :: Int -> CapacityReservation -> Int
hashWithSalt Int
_salt CapacityReservation' {Maybe Bool
Maybe Int
Maybe [CapacityAllocation]
Maybe [Tag]
Maybe Text
Maybe ISO8601
Maybe CapacityReservationInstancePlatform
Maybe CapacityReservationState
Maybe CapacityReservationTenancy
Maybe EndDateType
Maybe InstanceMatchCriteria
totalInstanceCount :: Maybe Int
tenancy :: Maybe CapacityReservationTenancy
tags :: Maybe [Tag]
state :: Maybe CapacityReservationState
startDate :: Maybe ISO8601
placementGroupArn :: Maybe Text
ownerId :: Maybe Text
outpostArn :: Maybe Text
instanceType :: Maybe Text
instancePlatform :: Maybe CapacityReservationInstancePlatform
instanceMatchCriteria :: Maybe InstanceMatchCriteria
ephemeralStorage :: Maybe Bool
endDateType :: Maybe EndDateType
endDate :: Maybe ISO8601
ebsOptimized :: Maybe Bool
createDate :: Maybe ISO8601
capacityReservationId :: Maybe Text
capacityReservationFleetId :: Maybe Text
capacityReservationArn :: Maybe Text
capacityAllocations :: Maybe [CapacityAllocation]
availableInstanceCount :: Maybe Int
availabilityZoneId :: Maybe Text
availabilityZone :: Maybe Text
$sel:totalInstanceCount:CapacityReservation' :: CapacityReservation -> Maybe Int
$sel:tenancy:CapacityReservation' :: CapacityReservation -> Maybe CapacityReservationTenancy
$sel:tags:CapacityReservation' :: CapacityReservation -> Maybe [Tag]
$sel:state:CapacityReservation' :: CapacityReservation -> Maybe CapacityReservationState
$sel:startDate:CapacityReservation' :: CapacityReservation -> Maybe ISO8601
$sel:placementGroupArn:CapacityReservation' :: CapacityReservation -> Maybe Text
$sel:ownerId:CapacityReservation' :: CapacityReservation -> Maybe Text
$sel:outpostArn:CapacityReservation' :: CapacityReservation -> Maybe Text
$sel:instanceType:CapacityReservation' :: CapacityReservation -> Maybe Text
$sel:instancePlatform:CapacityReservation' :: CapacityReservation -> Maybe CapacityReservationInstancePlatform
$sel:instanceMatchCriteria:CapacityReservation' :: CapacityReservation -> Maybe InstanceMatchCriteria
$sel:ephemeralStorage:CapacityReservation' :: CapacityReservation -> Maybe Bool
$sel:endDateType:CapacityReservation' :: CapacityReservation -> Maybe EndDateType
$sel:endDate:CapacityReservation' :: CapacityReservation -> Maybe ISO8601
$sel:ebsOptimized:CapacityReservation' :: CapacityReservation -> Maybe Bool
$sel:createDate:CapacityReservation' :: CapacityReservation -> Maybe ISO8601
$sel:capacityReservationId:CapacityReservation' :: CapacityReservation -> Maybe Text
$sel:capacityReservationFleetId:CapacityReservation' :: CapacityReservation -> Maybe Text
$sel:capacityReservationArn:CapacityReservation' :: CapacityReservation -> Maybe Text
$sel:capacityAllocations:CapacityReservation' :: CapacityReservation -> Maybe [CapacityAllocation]
$sel:availableInstanceCount:CapacityReservation' :: CapacityReservation -> Maybe Int
$sel:availabilityZoneId:CapacityReservation' :: CapacityReservation -> Maybe Text
$sel:availabilityZone:CapacityReservation' :: CapacityReservation -> Maybe Text
..} =
    Int
_salt
      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 Int
availableInstanceCount
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [CapacityAllocation]
capacityAllocations
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
capacityReservationArn
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
capacityReservationFleetId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
capacityReservationId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe ISO8601
createDate
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Bool
ebsOptimized
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe ISO8601
endDate
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe EndDateType
endDateType
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Bool
ephemeralStorage
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe InstanceMatchCriteria
instanceMatchCriteria
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe CapacityReservationInstancePlatform
instancePlatform
      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 Text
ownerId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
placementGroupArn
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe ISO8601
startDate
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe CapacityReservationState
state
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [Tag]
tags
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe CapacityReservationTenancy
tenancy
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Int
totalInstanceCount

instance Prelude.NFData CapacityReservation where
  rnf :: CapacityReservation -> ()
rnf CapacityReservation' {Maybe Bool
Maybe Int
Maybe [CapacityAllocation]
Maybe [Tag]
Maybe Text
Maybe ISO8601
Maybe CapacityReservationInstancePlatform
Maybe CapacityReservationState
Maybe CapacityReservationTenancy
Maybe EndDateType
Maybe InstanceMatchCriteria
totalInstanceCount :: Maybe Int
tenancy :: Maybe CapacityReservationTenancy
tags :: Maybe [Tag]
state :: Maybe CapacityReservationState
startDate :: Maybe ISO8601
placementGroupArn :: Maybe Text
ownerId :: Maybe Text
outpostArn :: Maybe Text
instanceType :: Maybe Text
instancePlatform :: Maybe CapacityReservationInstancePlatform
instanceMatchCriteria :: Maybe InstanceMatchCriteria
ephemeralStorage :: Maybe Bool
endDateType :: Maybe EndDateType
endDate :: Maybe ISO8601
ebsOptimized :: Maybe Bool
createDate :: Maybe ISO8601
capacityReservationId :: Maybe Text
capacityReservationFleetId :: Maybe Text
capacityReservationArn :: Maybe Text
capacityAllocations :: Maybe [CapacityAllocation]
availableInstanceCount :: Maybe Int
availabilityZoneId :: Maybe Text
availabilityZone :: Maybe Text
$sel:totalInstanceCount:CapacityReservation' :: CapacityReservation -> Maybe Int
$sel:tenancy:CapacityReservation' :: CapacityReservation -> Maybe CapacityReservationTenancy
$sel:tags:CapacityReservation' :: CapacityReservation -> Maybe [Tag]
$sel:state:CapacityReservation' :: CapacityReservation -> Maybe CapacityReservationState
$sel:startDate:CapacityReservation' :: CapacityReservation -> Maybe ISO8601
$sel:placementGroupArn:CapacityReservation' :: CapacityReservation -> Maybe Text
$sel:ownerId:CapacityReservation' :: CapacityReservation -> Maybe Text
$sel:outpostArn:CapacityReservation' :: CapacityReservation -> Maybe Text
$sel:instanceType:CapacityReservation' :: CapacityReservation -> Maybe Text
$sel:instancePlatform:CapacityReservation' :: CapacityReservation -> Maybe CapacityReservationInstancePlatform
$sel:instanceMatchCriteria:CapacityReservation' :: CapacityReservation -> Maybe InstanceMatchCriteria
$sel:ephemeralStorage:CapacityReservation' :: CapacityReservation -> Maybe Bool
$sel:endDateType:CapacityReservation' :: CapacityReservation -> Maybe EndDateType
$sel:endDate:CapacityReservation' :: CapacityReservation -> Maybe ISO8601
$sel:ebsOptimized:CapacityReservation' :: CapacityReservation -> Maybe Bool
$sel:createDate:CapacityReservation' :: CapacityReservation -> Maybe ISO8601
$sel:capacityReservationId:CapacityReservation' :: CapacityReservation -> Maybe Text
$sel:capacityReservationFleetId:CapacityReservation' :: CapacityReservation -> Maybe Text
$sel:capacityReservationArn:CapacityReservation' :: CapacityReservation -> Maybe Text
$sel:capacityAllocations:CapacityReservation' :: CapacityReservation -> Maybe [CapacityAllocation]
$sel:availableInstanceCount:CapacityReservation' :: CapacityReservation -> Maybe Int
$sel:availabilityZoneId:CapacityReservation' :: CapacityReservation -> Maybe Text
$sel:availabilityZone:CapacityReservation' :: CapacityReservation -> Maybe Text
..} =
    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 Int
availableInstanceCount
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [CapacityAllocation]
capacityAllocations
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
capacityReservationArn
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
capacityReservationFleetId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
capacityReservationId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe ISO8601
createDate
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Bool
ebsOptimized
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe ISO8601
endDate
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe EndDateType
endDateType
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Bool
ephemeralStorage
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe InstanceMatchCriteria
instanceMatchCriteria
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe CapacityReservationInstancePlatform
instancePlatform
      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 Text
ownerId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
placementGroupArn
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe ISO8601
startDate
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe CapacityReservationState
state
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [Tag]
tags
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe CapacityReservationTenancy
tenancy
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf
        Maybe Int
totalInstanceCount