{-# 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.Reservation
-- 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.Reservation 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.GroupIdentifier
import Amazonka.EC2.Types.Instance
import qualified Amazonka.Prelude as Prelude

-- | Describes a launch request for one or more instances, and includes
-- owner, requester, and security group information that applies to all
-- instances in the launch request.
--
-- /See:/ 'newReservation' smart constructor.
data Reservation = Reservation'
  { -- | [EC2-Classic only] The security groups.
    Reservation -> Maybe [GroupIdentifier]
groups :: Prelude.Maybe [GroupIdentifier],
    -- | The instances.
    Reservation -> Maybe [Instance]
instances :: Prelude.Maybe [Instance],
    -- | The ID of the requester that launched the instances on your behalf (for
    -- example, Amazon Web Services Management Console or Auto Scaling).
    Reservation -> Maybe Text
requesterId :: Prelude.Maybe Prelude.Text,
    -- | The ID of the reservation.
    Reservation -> Text
reservationId :: Prelude.Text,
    -- | The ID of the Amazon Web Services account that owns the reservation.
    Reservation -> Text
ownerId :: Prelude.Text
  }
  deriving (Reservation -> Reservation -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Reservation -> Reservation -> Bool
$c/= :: Reservation -> Reservation -> Bool
== :: Reservation -> Reservation -> Bool
$c== :: Reservation -> Reservation -> Bool
Prelude.Eq, ReadPrec [Reservation]
ReadPrec Reservation
Int -> ReadS Reservation
ReadS [Reservation]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Reservation]
$creadListPrec :: ReadPrec [Reservation]
readPrec :: ReadPrec Reservation
$creadPrec :: ReadPrec Reservation
readList :: ReadS [Reservation]
$creadList :: ReadS [Reservation]
readsPrec :: Int -> ReadS Reservation
$creadsPrec :: Int -> ReadS Reservation
Prelude.Read, Int -> Reservation -> ShowS
[Reservation] -> ShowS
Reservation -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Reservation] -> ShowS
$cshowList :: [Reservation] -> ShowS
show :: Reservation -> String
$cshow :: Reservation -> String
showsPrec :: Int -> Reservation -> ShowS
$cshowsPrec :: Int -> Reservation -> ShowS
Prelude.Show, forall x. Rep Reservation x -> Reservation
forall x. Reservation -> Rep Reservation x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Reservation x -> Reservation
$cfrom :: forall x. Reservation -> Rep Reservation x
Prelude.Generic)

-- |
-- Create a value of 'Reservation' 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:
--
-- 'groups', 'reservation_groups' - [EC2-Classic only] The security groups.
--
-- 'instances', 'reservation_instances' - The instances.
--
-- 'requesterId', 'reservation_requesterId' - The ID of the requester that launched the instances on your behalf (for
-- example, Amazon Web Services Management Console or Auto Scaling).
--
-- 'reservationId', 'reservation_reservationId' - The ID of the reservation.
--
-- 'ownerId', 'reservation_ownerId' - The ID of the Amazon Web Services account that owns the reservation.
newReservation ::
  -- | 'reservationId'
  Prelude.Text ->
  -- | 'ownerId'
  Prelude.Text ->
  Reservation
newReservation :: Text -> Text -> Reservation
newReservation Text
pReservationId_ Text
pOwnerId_ =
  Reservation'
    { $sel:groups:Reservation' :: Maybe [GroupIdentifier]
groups = forall a. Maybe a
Prelude.Nothing,
      $sel:instances:Reservation' :: Maybe [Instance]
instances = forall a. Maybe a
Prelude.Nothing,
      $sel:requesterId:Reservation' :: Maybe Text
requesterId = forall a. Maybe a
Prelude.Nothing,
      $sel:reservationId:Reservation' :: Text
reservationId = Text
pReservationId_,
      $sel:ownerId:Reservation' :: Text
ownerId = Text
pOwnerId_
    }

-- | [EC2-Classic only] The security groups.
reservation_groups :: Lens.Lens' Reservation (Prelude.Maybe [GroupIdentifier])
reservation_groups :: Lens' Reservation (Maybe [GroupIdentifier])
reservation_groups = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Reservation' {Maybe [GroupIdentifier]
groups :: Maybe [GroupIdentifier]
$sel:groups:Reservation' :: Reservation -> Maybe [GroupIdentifier]
groups} -> Maybe [GroupIdentifier]
groups) (\s :: Reservation
s@Reservation' {} Maybe [GroupIdentifier]
a -> Reservation
s {$sel:groups:Reservation' :: Maybe [GroupIdentifier]
groups = Maybe [GroupIdentifier]
a} :: Reservation) 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 instances.
reservation_instances :: Lens.Lens' Reservation (Prelude.Maybe [Instance])
reservation_instances :: Lens' Reservation (Maybe [Instance])
reservation_instances = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Reservation' {Maybe [Instance]
instances :: Maybe [Instance]
$sel:instances:Reservation' :: Reservation -> Maybe [Instance]
instances} -> Maybe [Instance]
instances) (\s :: Reservation
s@Reservation' {} Maybe [Instance]
a -> Reservation
s {$sel:instances:Reservation' :: Maybe [Instance]
instances = Maybe [Instance]
a} :: Reservation) 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 ID of the requester that launched the instances on your behalf (for
-- example, Amazon Web Services Management Console or Auto Scaling).
reservation_requesterId :: Lens.Lens' Reservation (Prelude.Maybe Prelude.Text)
reservation_requesterId :: Lens' Reservation (Maybe Text)
reservation_requesterId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Reservation' {Maybe Text
requesterId :: Maybe Text
$sel:requesterId:Reservation' :: Reservation -> Maybe Text
requesterId} -> Maybe Text
requesterId) (\s :: Reservation
s@Reservation' {} Maybe Text
a -> Reservation
s {$sel:requesterId:Reservation' :: Maybe Text
requesterId = Maybe Text
a} :: Reservation)

-- | The ID of the reservation.
reservation_reservationId :: Lens.Lens' Reservation Prelude.Text
reservation_reservationId :: Lens' Reservation Text
reservation_reservationId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Reservation' {Text
reservationId :: Text
$sel:reservationId:Reservation' :: Reservation -> Text
reservationId} -> Text
reservationId) (\s :: Reservation
s@Reservation' {} Text
a -> Reservation
s {$sel:reservationId:Reservation' :: Text
reservationId = Text
a} :: Reservation)

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

instance Data.FromXML Reservation where
  parseXML :: [Node] -> Either String Reservation
parseXML [Node]
x =
    Maybe [GroupIdentifier]
-> Maybe [Instance] -> Maybe Text -> Text -> Text -> Reservation
Reservation'
      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
"groupSet"
                      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
"instancesSet"
                      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
"requesterId")
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> ([Node]
x forall a. FromXML a => [Node] -> Text -> Either String a
Data..@ Text
"reservationId")
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> ([Node]
x forall a. FromXML a => [Node] -> Text -> Either String a
Data..@ Text
"ownerId")

instance Prelude.Hashable Reservation where
  hashWithSalt :: Int -> Reservation -> Int
hashWithSalt Int
_salt Reservation' {Maybe [GroupIdentifier]
Maybe [Instance]
Maybe Text
Text
ownerId :: Text
reservationId :: Text
requesterId :: Maybe Text
instances :: Maybe [Instance]
groups :: Maybe [GroupIdentifier]
$sel:ownerId:Reservation' :: Reservation -> Text
$sel:reservationId:Reservation' :: Reservation -> Text
$sel:requesterId:Reservation' :: Reservation -> Maybe Text
$sel:instances:Reservation' :: Reservation -> Maybe [Instance]
$sel:groups:Reservation' :: Reservation -> Maybe [GroupIdentifier]
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [GroupIdentifier]
groups
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [Instance]
instances
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
requesterId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
reservationId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
ownerId

instance Prelude.NFData Reservation where
  rnf :: Reservation -> ()
rnf Reservation' {Maybe [GroupIdentifier]
Maybe [Instance]
Maybe Text
Text
ownerId :: Text
reservationId :: Text
requesterId :: Maybe Text
instances :: Maybe [Instance]
groups :: Maybe [GroupIdentifier]
$sel:ownerId:Reservation' :: Reservation -> Text
$sel:reservationId:Reservation' :: Reservation -> Text
$sel:requesterId:Reservation' :: Reservation -> Maybe Text
$sel:instances:Reservation' :: Reservation -> Maybe [Instance]
$sel:groups:Reservation' :: Reservation -> Maybe [GroupIdentifier]
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe [GroupIdentifier]
groups
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [Instance]
instances
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
requesterId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
reservationId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
ownerId