{-# 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.ELBV2.Types.LoadBalancer
-- 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.ELBV2.Types.LoadBalancer where

import qualified Amazonka.Core as Core
import qualified Amazonka.Core.Lens.Internal as Lens
import qualified Amazonka.Data as Data
import Amazonka.ELBV2.Types.AvailabilityZone
import Amazonka.ELBV2.Types.IpAddressType
import Amazonka.ELBV2.Types.LoadBalancerSchemeEnum
import Amazonka.ELBV2.Types.LoadBalancerState
import Amazonka.ELBV2.Types.LoadBalancerTypeEnum
import qualified Amazonka.Prelude as Prelude

-- | Information about a load balancer.
--
-- /See:/ 'newLoadBalancer' smart constructor.
data LoadBalancer = LoadBalancer'
  { -- | The subnets for the load balancer.
    LoadBalancer -> Maybe [AvailabilityZone]
availabilityZones :: Prelude.Maybe [AvailabilityZone],
    -- | The ID of the Amazon Route 53 hosted zone associated with the load
    -- balancer.
    LoadBalancer -> Maybe Text
canonicalHostedZoneId :: Prelude.Maybe Prelude.Text,
    -- | The date and time the load balancer was created.
    LoadBalancer -> Maybe ISO8601
createdTime :: Prelude.Maybe Data.ISO8601,
    -- | [Application Load Balancers on Outposts] The ID of the customer-owned
    -- address pool.
    LoadBalancer -> Maybe Text
customerOwnedIpv4Pool :: Prelude.Maybe Prelude.Text,
    -- | The public DNS name of the load balancer.
    LoadBalancer -> Maybe Text
dNSName :: Prelude.Maybe Prelude.Text,
    -- | The type of IP addresses used by the subnets for your load balancer. The
    -- possible values are @ipv4@ (for IPv4 addresses) and @dualstack@ (for
    -- IPv4 and IPv6 addresses).
    LoadBalancer -> Maybe IpAddressType
ipAddressType :: Prelude.Maybe IpAddressType,
    -- | The Amazon Resource Name (ARN) of the load balancer.
    LoadBalancer -> Maybe Text
loadBalancerArn :: Prelude.Maybe Prelude.Text,
    -- | The name of the load balancer.
    LoadBalancer -> Maybe Text
loadBalancerName :: Prelude.Maybe Prelude.Text,
    -- | The nodes of an Internet-facing load balancer have public IP addresses.
    -- The DNS name of an Internet-facing load balancer is publicly resolvable
    -- to the public IP addresses of the nodes. Therefore, Internet-facing load
    -- balancers can route requests from clients over the internet.
    --
    -- The nodes of an internal load balancer have only private IP addresses.
    -- The DNS name of an internal load balancer is publicly resolvable to the
    -- private IP addresses of the nodes. Therefore, internal load balancers
    -- can route requests only from clients with access to the VPC for the load
    -- balancer.
    LoadBalancer -> Maybe LoadBalancerSchemeEnum
scheme :: Prelude.Maybe LoadBalancerSchemeEnum,
    -- | The IDs of the security groups for the load balancer.
    LoadBalancer -> Maybe [Text]
securityGroups :: Prelude.Maybe [Prelude.Text],
    -- | The state of the load balancer.
    LoadBalancer -> Maybe LoadBalancerState
state :: Prelude.Maybe LoadBalancerState,
    -- | The type of load balancer.
    LoadBalancer -> Maybe LoadBalancerTypeEnum
type' :: Prelude.Maybe LoadBalancerTypeEnum,
    -- | The ID of the VPC for the load balancer.
    LoadBalancer -> Maybe Text
vpcId :: Prelude.Maybe Prelude.Text
  }
  deriving (LoadBalancer -> LoadBalancer -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: LoadBalancer -> LoadBalancer -> Bool
$c/= :: LoadBalancer -> LoadBalancer -> Bool
== :: LoadBalancer -> LoadBalancer -> Bool
$c== :: LoadBalancer -> LoadBalancer -> Bool
Prelude.Eq, ReadPrec [LoadBalancer]
ReadPrec LoadBalancer
Int -> ReadS LoadBalancer
ReadS [LoadBalancer]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [LoadBalancer]
$creadListPrec :: ReadPrec [LoadBalancer]
readPrec :: ReadPrec LoadBalancer
$creadPrec :: ReadPrec LoadBalancer
readList :: ReadS [LoadBalancer]
$creadList :: ReadS [LoadBalancer]
readsPrec :: Int -> ReadS LoadBalancer
$creadsPrec :: Int -> ReadS LoadBalancer
Prelude.Read, Int -> LoadBalancer -> ShowS
[LoadBalancer] -> ShowS
LoadBalancer -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [LoadBalancer] -> ShowS
$cshowList :: [LoadBalancer] -> ShowS
show :: LoadBalancer -> String
$cshow :: LoadBalancer -> String
showsPrec :: Int -> LoadBalancer -> ShowS
$cshowsPrec :: Int -> LoadBalancer -> ShowS
Prelude.Show, forall x. Rep LoadBalancer x -> LoadBalancer
forall x. LoadBalancer -> Rep LoadBalancer x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep LoadBalancer x -> LoadBalancer
$cfrom :: forall x. LoadBalancer -> Rep LoadBalancer x
Prelude.Generic)

-- |
-- Create a value of 'LoadBalancer' 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:
--
-- 'availabilityZones', 'loadBalancer_availabilityZones' - The subnets for the load balancer.
--
-- 'canonicalHostedZoneId', 'loadBalancer_canonicalHostedZoneId' - The ID of the Amazon Route 53 hosted zone associated with the load
-- balancer.
--
-- 'createdTime', 'loadBalancer_createdTime' - The date and time the load balancer was created.
--
-- 'customerOwnedIpv4Pool', 'loadBalancer_customerOwnedIpv4Pool' - [Application Load Balancers on Outposts] The ID of the customer-owned
-- address pool.
--
-- 'dNSName', 'loadBalancer_dNSName' - The public DNS name of the load balancer.
--
-- 'ipAddressType', 'loadBalancer_ipAddressType' - The type of IP addresses used by the subnets for your load balancer. The
-- possible values are @ipv4@ (for IPv4 addresses) and @dualstack@ (for
-- IPv4 and IPv6 addresses).
--
-- 'loadBalancerArn', 'loadBalancer_loadBalancerArn' - The Amazon Resource Name (ARN) of the load balancer.
--
-- 'loadBalancerName', 'loadBalancer_loadBalancerName' - The name of the load balancer.
--
-- 'scheme', 'loadBalancer_scheme' - The nodes of an Internet-facing load balancer have public IP addresses.
-- The DNS name of an Internet-facing load balancer is publicly resolvable
-- to the public IP addresses of the nodes. Therefore, Internet-facing load
-- balancers can route requests from clients over the internet.
--
-- The nodes of an internal load balancer have only private IP addresses.
-- The DNS name of an internal load balancer is publicly resolvable to the
-- private IP addresses of the nodes. Therefore, internal load balancers
-- can route requests only from clients with access to the VPC for the load
-- balancer.
--
-- 'securityGroups', 'loadBalancer_securityGroups' - The IDs of the security groups for the load balancer.
--
-- 'state', 'loadBalancer_state' - The state of the load balancer.
--
-- 'type'', 'loadBalancer_type' - The type of load balancer.
--
-- 'vpcId', 'loadBalancer_vpcId' - The ID of the VPC for the load balancer.
newLoadBalancer ::
  LoadBalancer
newLoadBalancer :: LoadBalancer
newLoadBalancer =
  LoadBalancer'
    { $sel:availabilityZones:LoadBalancer' :: Maybe [AvailabilityZone]
availabilityZones = forall a. Maybe a
Prelude.Nothing,
      $sel:canonicalHostedZoneId:LoadBalancer' :: Maybe Text
canonicalHostedZoneId = forall a. Maybe a
Prelude.Nothing,
      $sel:createdTime:LoadBalancer' :: Maybe ISO8601
createdTime = forall a. Maybe a
Prelude.Nothing,
      $sel:customerOwnedIpv4Pool:LoadBalancer' :: Maybe Text
customerOwnedIpv4Pool = forall a. Maybe a
Prelude.Nothing,
      $sel:dNSName:LoadBalancer' :: Maybe Text
dNSName = forall a. Maybe a
Prelude.Nothing,
      $sel:ipAddressType:LoadBalancer' :: Maybe IpAddressType
ipAddressType = forall a. Maybe a
Prelude.Nothing,
      $sel:loadBalancerArn:LoadBalancer' :: Maybe Text
loadBalancerArn = forall a. Maybe a
Prelude.Nothing,
      $sel:loadBalancerName:LoadBalancer' :: Maybe Text
loadBalancerName = forall a. Maybe a
Prelude.Nothing,
      $sel:scheme:LoadBalancer' :: Maybe LoadBalancerSchemeEnum
scheme = forall a. Maybe a
Prelude.Nothing,
      $sel:securityGroups:LoadBalancer' :: Maybe [Text]
securityGroups = forall a. Maybe a
Prelude.Nothing,
      $sel:state:LoadBalancer' :: Maybe LoadBalancerState
state = forall a. Maybe a
Prelude.Nothing,
      $sel:type':LoadBalancer' :: Maybe LoadBalancerTypeEnum
type' = forall a. Maybe a
Prelude.Nothing,
      $sel:vpcId:LoadBalancer' :: Maybe Text
vpcId = forall a. Maybe a
Prelude.Nothing
    }

-- | The subnets for the load balancer.
loadBalancer_availabilityZones :: Lens.Lens' LoadBalancer (Prelude.Maybe [AvailabilityZone])
loadBalancer_availabilityZones :: Lens' LoadBalancer (Maybe [AvailabilityZone])
loadBalancer_availabilityZones = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\LoadBalancer' {Maybe [AvailabilityZone]
availabilityZones :: Maybe [AvailabilityZone]
$sel:availabilityZones:LoadBalancer' :: LoadBalancer -> Maybe [AvailabilityZone]
availabilityZones} -> Maybe [AvailabilityZone]
availabilityZones) (\s :: LoadBalancer
s@LoadBalancer' {} Maybe [AvailabilityZone]
a -> LoadBalancer
s {$sel:availabilityZones:LoadBalancer' :: Maybe [AvailabilityZone]
availabilityZones = Maybe [AvailabilityZone]
a} :: LoadBalancer) 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 Amazon Route 53 hosted zone associated with the load
-- balancer.
loadBalancer_canonicalHostedZoneId :: Lens.Lens' LoadBalancer (Prelude.Maybe Prelude.Text)
loadBalancer_canonicalHostedZoneId :: Lens' LoadBalancer (Maybe Text)
loadBalancer_canonicalHostedZoneId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\LoadBalancer' {Maybe Text
canonicalHostedZoneId :: Maybe Text
$sel:canonicalHostedZoneId:LoadBalancer' :: LoadBalancer -> Maybe Text
canonicalHostedZoneId} -> Maybe Text
canonicalHostedZoneId) (\s :: LoadBalancer
s@LoadBalancer' {} Maybe Text
a -> LoadBalancer
s {$sel:canonicalHostedZoneId:LoadBalancer' :: Maybe Text
canonicalHostedZoneId = Maybe Text
a} :: LoadBalancer)

-- | The date and time the load balancer was created.
loadBalancer_createdTime :: Lens.Lens' LoadBalancer (Prelude.Maybe Prelude.UTCTime)
loadBalancer_createdTime :: Lens' LoadBalancer (Maybe UTCTime)
loadBalancer_createdTime = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\LoadBalancer' {Maybe ISO8601
createdTime :: Maybe ISO8601
$sel:createdTime:LoadBalancer' :: LoadBalancer -> Maybe ISO8601
createdTime} -> Maybe ISO8601
createdTime) (\s :: LoadBalancer
s@LoadBalancer' {} Maybe ISO8601
a -> LoadBalancer
s {$sel:createdTime:LoadBalancer' :: Maybe ISO8601
createdTime = Maybe ISO8601
a} :: LoadBalancer) 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

-- | [Application Load Balancers on Outposts] The ID of the customer-owned
-- address pool.
loadBalancer_customerOwnedIpv4Pool :: Lens.Lens' LoadBalancer (Prelude.Maybe Prelude.Text)
loadBalancer_customerOwnedIpv4Pool :: Lens' LoadBalancer (Maybe Text)
loadBalancer_customerOwnedIpv4Pool = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\LoadBalancer' {Maybe Text
customerOwnedIpv4Pool :: Maybe Text
$sel:customerOwnedIpv4Pool:LoadBalancer' :: LoadBalancer -> Maybe Text
customerOwnedIpv4Pool} -> Maybe Text
customerOwnedIpv4Pool) (\s :: LoadBalancer
s@LoadBalancer' {} Maybe Text
a -> LoadBalancer
s {$sel:customerOwnedIpv4Pool:LoadBalancer' :: Maybe Text
customerOwnedIpv4Pool = Maybe Text
a} :: LoadBalancer)

-- | The public DNS name of the load balancer.
loadBalancer_dNSName :: Lens.Lens' LoadBalancer (Prelude.Maybe Prelude.Text)
loadBalancer_dNSName :: Lens' LoadBalancer (Maybe Text)
loadBalancer_dNSName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\LoadBalancer' {Maybe Text
dNSName :: Maybe Text
$sel:dNSName:LoadBalancer' :: LoadBalancer -> Maybe Text
dNSName} -> Maybe Text
dNSName) (\s :: LoadBalancer
s@LoadBalancer' {} Maybe Text
a -> LoadBalancer
s {$sel:dNSName:LoadBalancer' :: Maybe Text
dNSName = Maybe Text
a} :: LoadBalancer)

-- | The type of IP addresses used by the subnets for your load balancer. The
-- possible values are @ipv4@ (for IPv4 addresses) and @dualstack@ (for
-- IPv4 and IPv6 addresses).
loadBalancer_ipAddressType :: Lens.Lens' LoadBalancer (Prelude.Maybe IpAddressType)
loadBalancer_ipAddressType :: Lens' LoadBalancer (Maybe IpAddressType)
loadBalancer_ipAddressType = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\LoadBalancer' {Maybe IpAddressType
ipAddressType :: Maybe IpAddressType
$sel:ipAddressType:LoadBalancer' :: LoadBalancer -> Maybe IpAddressType
ipAddressType} -> Maybe IpAddressType
ipAddressType) (\s :: LoadBalancer
s@LoadBalancer' {} Maybe IpAddressType
a -> LoadBalancer
s {$sel:ipAddressType:LoadBalancer' :: Maybe IpAddressType
ipAddressType = Maybe IpAddressType
a} :: LoadBalancer)

-- | The Amazon Resource Name (ARN) of the load balancer.
loadBalancer_loadBalancerArn :: Lens.Lens' LoadBalancer (Prelude.Maybe Prelude.Text)
loadBalancer_loadBalancerArn :: Lens' LoadBalancer (Maybe Text)
loadBalancer_loadBalancerArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\LoadBalancer' {Maybe Text
loadBalancerArn :: Maybe Text
$sel:loadBalancerArn:LoadBalancer' :: LoadBalancer -> Maybe Text
loadBalancerArn} -> Maybe Text
loadBalancerArn) (\s :: LoadBalancer
s@LoadBalancer' {} Maybe Text
a -> LoadBalancer
s {$sel:loadBalancerArn:LoadBalancer' :: Maybe Text
loadBalancerArn = Maybe Text
a} :: LoadBalancer)

-- | The name of the load balancer.
loadBalancer_loadBalancerName :: Lens.Lens' LoadBalancer (Prelude.Maybe Prelude.Text)
loadBalancer_loadBalancerName :: Lens' LoadBalancer (Maybe Text)
loadBalancer_loadBalancerName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\LoadBalancer' {Maybe Text
loadBalancerName :: Maybe Text
$sel:loadBalancerName:LoadBalancer' :: LoadBalancer -> Maybe Text
loadBalancerName} -> Maybe Text
loadBalancerName) (\s :: LoadBalancer
s@LoadBalancer' {} Maybe Text
a -> LoadBalancer
s {$sel:loadBalancerName:LoadBalancer' :: Maybe Text
loadBalancerName = Maybe Text
a} :: LoadBalancer)

-- | The nodes of an Internet-facing load balancer have public IP addresses.
-- The DNS name of an Internet-facing load balancer is publicly resolvable
-- to the public IP addresses of the nodes. Therefore, Internet-facing load
-- balancers can route requests from clients over the internet.
--
-- The nodes of an internal load balancer have only private IP addresses.
-- The DNS name of an internal load balancer is publicly resolvable to the
-- private IP addresses of the nodes. Therefore, internal load balancers
-- can route requests only from clients with access to the VPC for the load
-- balancer.
loadBalancer_scheme :: Lens.Lens' LoadBalancer (Prelude.Maybe LoadBalancerSchemeEnum)
loadBalancer_scheme :: Lens' LoadBalancer (Maybe LoadBalancerSchemeEnum)
loadBalancer_scheme = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\LoadBalancer' {Maybe LoadBalancerSchemeEnum
scheme :: Maybe LoadBalancerSchemeEnum
$sel:scheme:LoadBalancer' :: LoadBalancer -> Maybe LoadBalancerSchemeEnum
scheme} -> Maybe LoadBalancerSchemeEnum
scheme) (\s :: LoadBalancer
s@LoadBalancer' {} Maybe LoadBalancerSchemeEnum
a -> LoadBalancer
s {$sel:scheme:LoadBalancer' :: Maybe LoadBalancerSchemeEnum
scheme = Maybe LoadBalancerSchemeEnum
a} :: LoadBalancer)

-- | The IDs of the security groups for the load balancer.
loadBalancer_securityGroups :: Lens.Lens' LoadBalancer (Prelude.Maybe [Prelude.Text])
loadBalancer_securityGroups :: Lens' LoadBalancer (Maybe [Text])
loadBalancer_securityGroups = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\LoadBalancer' {Maybe [Text]
securityGroups :: Maybe [Text]
$sel:securityGroups:LoadBalancer' :: LoadBalancer -> Maybe [Text]
securityGroups} -> Maybe [Text]
securityGroups) (\s :: LoadBalancer
s@LoadBalancer' {} Maybe [Text]
a -> LoadBalancer
s {$sel:securityGroups:LoadBalancer' :: Maybe [Text]
securityGroups = Maybe [Text]
a} :: LoadBalancer) 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 state of the load balancer.
loadBalancer_state :: Lens.Lens' LoadBalancer (Prelude.Maybe LoadBalancerState)
loadBalancer_state :: Lens' LoadBalancer (Maybe LoadBalancerState)
loadBalancer_state = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\LoadBalancer' {Maybe LoadBalancerState
state :: Maybe LoadBalancerState
$sel:state:LoadBalancer' :: LoadBalancer -> Maybe LoadBalancerState
state} -> Maybe LoadBalancerState
state) (\s :: LoadBalancer
s@LoadBalancer' {} Maybe LoadBalancerState
a -> LoadBalancer
s {$sel:state:LoadBalancer' :: Maybe LoadBalancerState
state = Maybe LoadBalancerState
a} :: LoadBalancer)

-- | The type of load balancer.
loadBalancer_type :: Lens.Lens' LoadBalancer (Prelude.Maybe LoadBalancerTypeEnum)
loadBalancer_type :: Lens' LoadBalancer (Maybe LoadBalancerTypeEnum)
loadBalancer_type = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\LoadBalancer' {Maybe LoadBalancerTypeEnum
type' :: Maybe LoadBalancerTypeEnum
$sel:type':LoadBalancer' :: LoadBalancer -> Maybe LoadBalancerTypeEnum
type'} -> Maybe LoadBalancerTypeEnum
type') (\s :: LoadBalancer
s@LoadBalancer' {} Maybe LoadBalancerTypeEnum
a -> LoadBalancer
s {$sel:type':LoadBalancer' :: Maybe LoadBalancerTypeEnum
type' = Maybe LoadBalancerTypeEnum
a} :: LoadBalancer)

-- | The ID of the VPC for the load balancer.
loadBalancer_vpcId :: Lens.Lens' LoadBalancer (Prelude.Maybe Prelude.Text)
loadBalancer_vpcId :: Lens' LoadBalancer (Maybe Text)
loadBalancer_vpcId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\LoadBalancer' {Maybe Text
vpcId :: Maybe Text
$sel:vpcId:LoadBalancer' :: LoadBalancer -> Maybe Text
vpcId} -> Maybe Text
vpcId) (\s :: LoadBalancer
s@LoadBalancer' {} Maybe Text
a -> LoadBalancer
s {$sel:vpcId:LoadBalancer' :: Maybe Text
vpcId = Maybe Text
a} :: LoadBalancer)

instance Data.FromXML LoadBalancer where
  parseXML :: [Node] -> Either String LoadBalancer
parseXML [Node]
x =
    Maybe [AvailabilityZone]
-> Maybe Text
-> Maybe ISO8601
-> Maybe Text
-> Maybe Text
-> Maybe IpAddressType
-> Maybe Text
-> Maybe Text
-> Maybe LoadBalancerSchemeEnum
-> Maybe [Text]
-> Maybe LoadBalancerState
-> Maybe LoadBalancerTypeEnum
-> Maybe Text
-> LoadBalancer
LoadBalancer'
      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
"AvailabilityZones"
                      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
"member")
                  )
      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
"CanonicalHostedZoneId")
      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
"CreatedTime")
      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
"CustomerOwnedIpv4Pool")
      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
"DNSName")
      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
"IpAddressType")
      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
"LoadBalancerArn")
      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
"LoadBalancerName")
      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
"Scheme")
      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
"SecurityGroups"
                      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
"member")
                  )
      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
"Type")
      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
"VpcId")

instance Prelude.Hashable LoadBalancer where
  hashWithSalt :: Int -> LoadBalancer -> Int
hashWithSalt Int
_salt LoadBalancer' {Maybe [Text]
Maybe [AvailabilityZone]
Maybe Text
Maybe ISO8601
Maybe IpAddressType
Maybe LoadBalancerSchemeEnum
Maybe LoadBalancerState
Maybe LoadBalancerTypeEnum
vpcId :: Maybe Text
type' :: Maybe LoadBalancerTypeEnum
state :: Maybe LoadBalancerState
securityGroups :: Maybe [Text]
scheme :: Maybe LoadBalancerSchemeEnum
loadBalancerName :: Maybe Text
loadBalancerArn :: Maybe Text
ipAddressType :: Maybe IpAddressType
dNSName :: Maybe Text
customerOwnedIpv4Pool :: Maybe Text
createdTime :: Maybe ISO8601
canonicalHostedZoneId :: Maybe Text
availabilityZones :: Maybe [AvailabilityZone]
$sel:vpcId:LoadBalancer' :: LoadBalancer -> Maybe Text
$sel:type':LoadBalancer' :: LoadBalancer -> Maybe LoadBalancerTypeEnum
$sel:state:LoadBalancer' :: LoadBalancer -> Maybe LoadBalancerState
$sel:securityGroups:LoadBalancer' :: LoadBalancer -> Maybe [Text]
$sel:scheme:LoadBalancer' :: LoadBalancer -> Maybe LoadBalancerSchemeEnum
$sel:loadBalancerName:LoadBalancer' :: LoadBalancer -> Maybe Text
$sel:loadBalancerArn:LoadBalancer' :: LoadBalancer -> Maybe Text
$sel:ipAddressType:LoadBalancer' :: LoadBalancer -> Maybe IpAddressType
$sel:dNSName:LoadBalancer' :: LoadBalancer -> Maybe Text
$sel:customerOwnedIpv4Pool:LoadBalancer' :: LoadBalancer -> Maybe Text
$sel:createdTime:LoadBalancer' :: LoadBalancer -> Maybe ISO8601
$sel:canonicalHostedZoneId:LoadBalancer' :: LoadBalancer -> Maybe Text
$sel:availabilityZones:LoadBalancer' :: LoadBalancer -> Maybe [AvailabilityZone]
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [AvailabilityZone]
availabilityZones
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
canonicalHostedZoneId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe ISO8601
createdTime
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
customerOwnedIpv4Pool
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
dNSName
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe IpAddressType
ipAddressType
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
loadBalancerArn
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
loadBalancerName
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe LoadBalancerSchemeEnum
scheme
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [Text]
securityGroups
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe LoadBalancerState
state
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe LoadBalancerTypeEnum
type'
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
vpcId

instance Prelude.NFData LoadBalancer where
  rnf :: LoadBalancer -> ()
rnf LoadBalancer' {Maybe [Text]
Maybe [AvailabilityZone]
Maybe Text
Maybe ISO8601
Maybe IpAddressType
Maybe LoadBalancerSchemeEnum
Maybe LoadBalancerState
Maybe LoadBalancerTypeEnum
vpcId :: Maybe Text
type' :: Maybe LoadBalancerTypeEnum
state :: Maybe LoadBalancerState
securityGroups :: Maybe [Text]
scheme :: Maybe LoadBalancerSchemeEnum
loadBalancerName :: Maybe Text
loadBalancerArn :: Maybe Text
ipAddressType :: Maybe IpAddressType
dNSName :: Maybe Text
customerOwnedIpv4Pool :: Maybe Text
createdTime :: Maybe ISO8601
canonicalHostedZoneId :: Maybe Text
availabilityZones :: Maybe [AvailabilityZone]
$sel:vpcId:LoadBalancer' :: LoadBalancer -> Maybe Text
$sel:type':LoadBalancer' :: LoadBalancer -> Maybe LoadBalancerTypeEnum
$sel:state:LoadBalancer' :: LoadBalancer -> Maybe LoadBalancerState
$sel:securityGroups:LoadBalancer' :: LoadBalancer -> Maybe [Text]
$sel:scheme:LoadBalancer' :: LoadBalancer -> Maybe LoadBalancerSchemeEnum
$sel:loadBalancerName:LoadBalancer' :: LoadBalancer -> Maybe Text
$sel:loadBalancerArn:LoadBalancer' :: LoadBalancer -> Maybe Text
$sel:ipAddressType:LoadBalancer' :: LoadBalancer -> Maybe IpAddressType
$sel:dNSName:LoadBalancer' :: LoadBalancer -> Maybe Text
$sel:customerOwnedIpv4Pool:LoadBalancer' :: LoadBalancer -> Maybe Text
$sel:createdTime:LoadBalancer' :: LoadBalancer -> Maybe ISO8601
$sel:canonicalHostedZoneId:LoadBalancer' :: LoadBalancer -> Maybe Text
$sel:availabilityZones:LoadBalancer' :: LoadBalancer -> Maybe [AvailabilityZone]
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe [AvailabilityZone]
availabilityZones
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
canonicalHostedZoneId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe ISO8601
createdTime
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
customerOwnedIpv4Pool
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
dNSName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe IpAddressType
ipAddressType
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
loadBalancerArn
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
loadBalancerName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe LoadBalancerSchemeEnum
scheme
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [Text]
securityGroups
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe LoadBalancerState
state
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe LoadBalancerTypeEnum
type'
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
vpcId