{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE StrictData #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# OPTIONS_GHC -fno-warn-unused-binds #-}
{-# OPTIONS_GHC -fno-warn-unused-imports #-}
{-# OPTIONS_GHC -fno-warn-unused-matches #-}

-- Derived from AWS service descriptions, licensed under Apache 2.0.

-- |
-- Module      : Amazonka.ELBV2.CreateLoadBalancer
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Creates an Application Load Balancer, Network Load Balancer, or Gateway
-- Load Balancer.
--
-- For more information, see the following:
--
-- -   <https://docs.aws.amazon.com/elasticloadbalancing/latest/application/application-load-balancers.html Application Load Balancers>
--
-- -   <https://docs.aws.amazon.com/elasticloadbalancing/latest/network/network-load-balancers.html Network Load Balancers>
--
-- -   <https://docs.aws.amazon.com/elasticloadbalancing/latest/gateway/gateway-load-balancers.html Gateway Load Balancers>
--
-- This operation is idempotent, which means that it completes at most one
-- time. If you attempt to create multiple load balancers with the same
-- settings, each call succeeds.
module Amazonka.ELBV2.CreateLoadBalancer
  ( -- * Creating a Request
    CreateLoadBalancer (..),
    newCreateLoadBalancer,

    -- * Request Lenses
    createLoadBalancer_customerOwnedIpv4Pool,
    createLoadBalancer_ipAddressType,
    createLoadBalancer_scheme,
    createLoadBalancer_securityGroups,
    createLoadBalancer_subnetMappings,
    createLoadBalancer_subnets,
    createLoadBalancer_tags,
    createLoadBalancer_type,
    createLoadBalancer_name,

    -- * Destructuring the Response
    CreateLoadBalancerResponse (..),
    newCreateLoadBalancerResponse,

    -- * Response Lenses
    createLoadBalancerResponse_loadBalancers,
    createLoadBalancerResponse_httpStatus,
  )
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
import qualified Amazonka.Prelude as Prelude
import qualified Amazonka.Request as Request
import qualified Amazonka.Response as Response

-- | /See:/ 'newCreateLoadBalancer' smart constructor.
data CreateLoadBalancer = CreateLoadBalancer'
  { -- | [Application Load Balancers on Outposts] The ID of the customer-owned
    -- address pool (CoIP pool).
    CreateLoadBalancer -> Maybe Text
customerOwnedIpv4Pool :: 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).
    CreateLoadBalancer -> Maybe IpAddressType
ipAddressType :: Prelude.Maybe IpAddressType,
    -- | 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.
    --
    -- The default is an Internet-facing load balancer.
    --
    -- You cannot specify a scheme for a Gateway Load Balancer.
    CreateLoadBalancer -> Maybe LoadBalancerSchemeEnum
scheme :: Prelude.Maybe LoadBalancerSchemeEnum,
    -- | [Application Load Balancers] The IDs of the security groups for the load
    -- balancer.
    CreateLoadBalancer -> Maybe [Text]
securityGroups :: Prelude.Maybe [Prelude.Text],
    -- | The IDs of the public subnets. You can specify only one subnet per
    -- Availability Zone. You must specify either subnets or subnet mappings,
    -- but not both.
    --
    -- [Application Load Balancers] You must specify subnets from at least two
    -- Availability Zones. You cannot specify Elastic IP addresses for your
    -- subnets.
    --
    -- [Application Load Balancers on Outposts] You must specify one Outpost
    -- subnet.
    --
    -- [Application Load Balancers on Local Zones] You can specify subnets from
    -- one or more Local Zones.
    --
    -- [Network Load Balancers] You can specify subnets from one or more
    -- Availability Zones. You can specify one Elastic IP address per subnet if
    -- you need static IP addresses for your internet-facing load balancer. For
    -- internal load balancers, you can specify one private IP address per
    -- subnet from the IPv4 range of the subnet. For internet-facing load
    -- balancer, you can specify one IPv6 address per subnet.
    --
    -- [Gateway Load Balancers] You can specify subnets from one or more
    -- Availability Zones. You cannot specify Elastic IP addresses for your
    -- subnets.
    CreateLoadBalancer -> Maybe [SubnetMapping]
subnetMappings :: Prelude.Maybe [SubnetMapping],
    -- | The IDs of the public subnets. You can specify only one subnet per
    -- Availability Zone. You must specify either subnets or subnet mappings,
    -- but not both. To specify an Elastic IP address, specify subnet mappings
    -- instead of subnets.
    --
    -- [Application Load Balancers] You must specify subnets from at least two
    -- Availability Zones.
    --
    -- [Application Load Balancers on Outposts] You must specify one Outpost
    -- subnet.
    --
    -- [Application Load Balancers on Local Zones] You can specify subnets from
    -- one or more Local Zones.
    --
    -- [Network Load Balancers] You can specify subnets from one or more
    -- Availability Zones.
    --
    -- [Gateway Load Balancers] You can specify subnets from one or more
    -- Availability Zones.
    CreateLoadBalancer -> Maybe [Text]
subnets :: Prelude.Maybe [Prelude.Text],
    -- | The tags to assign to the load balancer.
    CreateLoadBalancer -> Maybe (NonEmpty Tag)
tags :: Prelude.Maybe (Prelude.NonEmpty Tag),
    -- | The type of load balancer. The default is @application@.
    CreateLoadBalancer -> Maybe LoadBalancerTypeEnum
type' :: Prelude.Maybe LoadBalancerTypeEnum,
    -- | The name of the load balancer.
    --
    -- This name must be unique per region per account, can have a maximum of
    -- 32 characters, must contain only alphanumeric characters or hyphens,
    -- must not begin or end with a hyphen, and must not begin with
    -- \"internal-\".
    CreateLoadBalancer -> Text
name :: Prelude.Text
  }
  deriving (CreateLoadBalancer -> CreateLoadBalancer -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateLoadBalancer -> CreateLoadBalancer -> Bool
$c/= :: CreateLoadBalancer -> CreateLoadBalancer -> Bool
== :: CreateLoadBalancer -> CreateLoadBalancer -> Bool
$c== :: CreateLoadBalancer -> CreateLoadBalancer -> Bool
Prelude.Eq, ReadPrec [CreateLoadBalancer]
ReadPrec CreateLoadBalancer
Int -> ReadS CreateLoadBalancer
ReadS [CreateLoadBalancer]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CreateLoadBalancer]
$creadListPrec :: ReadPrec [CreateLoadBalancer]
readPrec :: ReadPrec CreateLoadBalancer
$creadPrec :: ReadPrec CreateLoadBalancer
readList :: ReadS [CreateLoadBalancer]
$creadList :: ReadS [CreateLoadBalancer]
readsPrec :: Int -> ReadS CreateLoadBalancer
$creadsPrec :: Int -> ReadS CreateLoadBalancer
Prelude.Read, Int -> CreateLoadBalancer -> ShowS
[CreateLoadBalancer] -> ShowS
CreateLoadBalancer -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateLoadBalancer] -> ShowS
$cshowList :: [CreateLoadBalancer] -> ShowS
show :: CreateLoadBalancer -> String
$cshow :: CreateLoadBalancer -> String
showsPrec :: Int -> CreateLoadBalancer -> ShowS
$cshowsPrec :: Int -> CreateLoadBalancer -> ShowS
Prelude.Show, forall x. Rep CreateLoadBalancer x -> CreateLoadBalancer
forall x. CreateLoadBalancer -> Rep CreateLoadBalancer x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CreateLoadBalancer x -> CreateLoadBalancer
$cfrom :: forall x. CreateLoadBalancer -> Rep CreateLoadBalancer x
Prelude.Generic)

-- |
-- Create a value of 'CreateLoadBalancer' 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:
--
-- 'customerOwnedIpv4Pool', 'createLoadBalancer_customerOwnedIpv4Pool' - [Application Load Balancers on Outposts] The ID of the customer-owned
-- address pool (CoIP pool).
--
-- 'ipAddressType', 'createLoadBalancer_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).
--
-- 'scheme', 'createLoadBalancer_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.
--
-- The default is an Internet-facing load balancer.
--
-- You cannot specify a scheme for a Gateway Load Balancer.
--
-- 'securityGroups', 'createLoadBalancer_securityGroups' - [Application Load Balancers] The IDs of the security groups for the load
-- balancer.
--
-- 'subnetMappings', 'createLoadBalancer_subnetMappings' - The IDs of the public subnets. You can specify only one subnet per
-- Availability Zone. You must specify either subnets or subnet mappings,
-- but not both.
--
-- [Application Load Balancers] You must specify subnets from at least two
-- Availability Zones. You cannot specify Elastic IP addresses for your
-- subnets.
--
-- [Application Load Balancers on Outposts] You must specify one Outpost
-- subnet.
--
-- [Application Load Balancers on Local Zones] You can specify subnets from
-- one or more Local Zones.
--
-- [Network Load Balancers] You can specify subnets from one or more
-- Availability Zones. You can specify one Elastic IP address per subnet if
-- you need static IP addresses for your internet-facing load balancer. For
-- internal load balancers, you can specify one private IP address per
-- subnet from the IPv4 range of the subnet. For internet-facing load
-- balancer, you can specify one IPv6 address per subnet.
--
-- [Gateway Load Balancers] You can specify subnets from one or more
-- Availability Zones. You cannot specify Elastic IP addresses for your
-- subnets.
--
-- 'subnets', 'createLoadBalancer_subnets' - The IDs of the public subnets. You can specify only one subnet per
-- Availability Zone. You must specify either subnets or subnet mappings,
-- but not both. To specify an Elastic IP address, specify subnet mappings
-- instead of subnets.
--
-- [Application Load Balancers] You must specify subnets from at least two
-- Availability Zones.
--
-- [Application Load Balancers on Outposts] You must specify one Outpost
-- subnet.
--
-- [Application Load Balancers on Local Zones] You can specify subnets from
-- one or more Local Zones.
--
-- [Network Load Balancers] You can specify subnets from one or more
-- Availability Zones.
--
-- [Gateway Load Balancers] You can specify subnets from one or more
-- Availability Zones.
--
-- 'tags', 'createLoadBalancer_tags' - The tags to assign to the load balancer.
--
-- 'type'', 'createLoadBalancer_type' - The type of load balancer. The default is @application@.
--
-- 'name', 'createLoadBalancer_name' - The name of the load balancer.
--
-- This name must be unique per region per account, can have a maximum of
-- 32 characters, must contain only alphanumeric characters or hyphens,
-- must not begin or end with a hyphen, and must not begin with
-- \"internal-\".
newCreateLoadBalancer ::
  -- | 'name'
  Prelude.Text ->
  CreateLoadBalancer
newCreateLoadBalancer :: Text -> CreateLoadBalancer
newCreateLoadBalancer Text
pName_ =
  CreateLoadBalancer'
    { $sel:customerOwnedIpv4Pool:CreateLoadBalancer' :: Maybe Text
customerOwnedIpv4Pool =
        forall a. Maybe a
Prelude.Nothing,
      $sel:ipAddressType:CreateLoadBalancer' :: Maybe IpAddressType
ipAddressType = forall a. Maybe a
Prelude.Nothing,
      $sel:scheme:CreateLoadBalancer' :: Maybe LoadBalancerSchemeEnum
scheme = forall a. Maybe a
Prelude.Nothing,
      $sel:securityGroups:CreateLoadBalancer' :: Maybe [Text]
securityGroups = forall a. Maybe a
Prelude.Nothing,
      $sel:subnetMappings:CreateLoadBalancer' :: Maybe [SubnetMapping]
subnetMappings = forall a. Maybe a
Prelude.Nothing,
      $sel:subnets:CreateLoadBalancer' :: Maybe [Text]
subnets = forall a. Maybe a
Prelude.Nothing,
      $sel:tags:CreateLoadBalancer' :: Maybe (NonEmpty Tag)
tags = forall a. Maybe a
Prelude.Nothing,
      $sel:type':CreateLoadBalancer' :: Maybe LoadBalancerTypeEnum
type' = forall a. Maybe a
Prelude.Nothing,
      $sel:name:CreateLoadBalancer' :: Text
name = Text
pName_
    }

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

-- | 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).
createLoadBalancer_ipAddressType :: Lens.Lens' CreateLoadBalancer (Prelude.Maybe IpAddressType)
createLoadBalancer_ipAddressType :: Lens' CreateLoadBalancer (Maybe IpAddressType)
createLoadBalancer_ipAddressType = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateLoadBalancer' {Maybe IpAddressType
ipAddressType :: Maybe IpAddressType
$sel:ipAddressType:CreateLoadBalancer' :: CreateLoadBalancer -> Maybe IpAddressType
ipAddressType} -> Maybe IpAddressType
ipAddressType) (\s :: CreateLoadBalancer
s@CreateLoadBalancer' {} Maybe IpAddressType
a -> CreateLoadBalancer
s {$sel:ipAddressType:CreateLoadBalancer' :: Maybe IpAddressType
ipAddressType = Maybe IpAddressType
a} :: CreateLoadBalancer)

-- | 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.
--
-- The default is an Internet-facing load balancer.
--
-- You cannot specify a scheme for a Gateway Load Balancer.
createLoadBalancer_scheme :: Lens.Lens' CreateLoadBalancer (Prelude.Maybe LoadBalancerSchemeEnum)
createLoadBalancer_scheme :: Lens' CreateLoadBalancer (Maybe LoadBalancerSchemeEnum)
createLoadBalancer_scheme = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateLoadBalancer' {Maybe LoadBalancerSchemeEnum
scheme :: Maybe LoadBalancerSchemeEnum
$sel:scheme:CreateLoadBalancer' :: CreateLoadBalancer -> Maybe LoadBalancerSchemeEnum
scheme} -> Maybe LoadBalancerSchemeEnum
scheme) (\s :: CreateLoadBalancer
s@CreateLoadBalancer' {} Maybe LoadBalancerSchemeEnum
a -> CreateLoadBalancer
s {$sel:scheme:CreateLoadBalancer' :: Maybe LoadBalancerSchemeEnum
scheme = Maybe LoadBalancerSchemeEnum
a} :: CreateLoadBalancer)

-- | [Application Load Balancers] The IDs of the security groups for the load
-- balancer.
createLoadBalancer_securityGroups :: Lens.Lens' CreateLoadBalancer (Prelude.Maybe [Prelude.Text])
createLoadBalancer_securityGroups :: Lens' CreateLoadBalancer (Maybe [Text])
createLoadBalancer_securityGroups = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateLoadBalancer' {Maybe [Text]
securityGroups :: Maybe [Text]
$sel:securityGroups:CreateLoadBalancer' :: CreateLoadBalancer -> Maybe [Text]
securityGroups} -> Maybe [Text]
securityGroups) (\s :: CreateLoadBalancer
s@CreateLoadBalancer' {} Maybe [Text]
a -> CreateLoadBalancer
s {$sel:securityGroups:CreateLoadBalancer' :: Maybe [Text]
securityGroups = Maybe [Text]
a} :: CreateLoadBalancer) 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 IDs of the public subnets. You can specify only one subnet per
-- Availability Zone. You must specify either subnets or subnet mappings,
-- but not both.
--
-- [Application Load Balancers] You must specify subnets from at least two
-- Availability Zones. You cannot specify Elastic IP addresses for your
-- subnets.
--
-- [Application Load Balancers on Outposts] You must specify one Outpost
-- subnet.
--
-- [Application Load Balancers on Local Zones] You can specify subnets from
-- one or more Local Zones.
--
-- [Network Load Balancers] You can specify subnets from one or more
-- Availability Zones. You can specify one Elastic IP address per subnet if
-- you need static IP addresses for your internet-facing load balancer. For
-- internal load balancers, you can specify one private IP address per
-- subnet from the IPv4 range of the subnet. For internet-facing load
-- balancer, you can specify one IPv6 address per subnet.
--
-- [Gateway Load Balancers] You can specify subnets from one or more
-- Availability Zones. You cannot specify Elastic IP addresses for your
-- subnets.
createLoadBalancer_subnetMappings :: Lens.Lens' CreateLoadBalancer (Prelude.Maybe [SubnetMapping])
createLoadBalancer_subnetMappings :: Lens' CreateLoadBalancer (Maybe [SubnetMapping])
createLoadBalancer_subnetMappings = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateLoadBalancer' {Maybe [SubnetMapping]
subnetMappings :: Maybe [SubnetMapping]
$sel:subnetMappings:CreateLoadBalancer' :: CreateLoadBalancer -> Maybe [SubnetMapping]
subnetMappings} -> Maybe [SubnetMapping]
subnetMappings) (\s :: CreateLoadBalancer
s@CreateLoadBalancer' {} Maybe [SubnetMapping]
a -> CreateLoadBalancer
s {$sel:subnetMappings:CreateLoadBalancer' :: Maybe [SubnetMapping]
subnetMappings = Maybe [SubnetMapping]
a} :: CreateLoadBalancer) 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 IDs of the public subnets. You can specify only one subnet per
-- Availability Zone. You must specify either subnets or subnet mappings,
-- but not both. To specify an Elastic IP address, specify subnet mappings
-- instead of subnets.
--
-- [Application Load Balancers] You must specify subnets from at least two
-- Availability Zones.
--
-- [Application Load Balancers on Outposts] You must specify one Outpost
-- subnet.
--
-- [Application Load Balancers on Local Zones] You can specify subnets from
-- one or more Local Zones.
--
-- [Network Load Balancers] You can specify subnets from one or more
-- Availability Zones.
--
-- [Gateway Load Balancers] You can specify subnets from one or more
-- Availability Zones.
createLoadBalancer_subnets :: Lens.Lens' CreateLoadBalancer (Prelude.Maybe [Prelude.Text])
createLoadBalancer_subnets :: Lens' CreateLoadBalancer (Maybe [Text])
createLoadBalancer_subnets = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateLoadBalancer' {Maybe [Text]
subnets :: Maybe [Text]
$sel:subnets:CreateLoadBalancer' :: CreateLoadBalancer -> Maybe [Text]
subnets} -> Maybe [Text]
subnets) (\s :: CreateLoadBalancer
s@CreateLoadBalancer' {} Maybe [Text]
a -> CreateLoadBalancer
s {$sel:subnets:CreateLoadBalancer' :: Maybe [Text]
subnets = Maybe [Text]
a} :: CreateLoadBalancer) 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 tags to assign to the load balancer.
createLoadBalancer_tags :: Lens.Lens' CreateLoadBalancer (Prelude.Maybe (Prelude.NonEmpty Tag))
createLoadBalancer_tags :: Lens' CreateLoadBalancer (Maybe (NonEmpty Tag))
createLoadBalancer_tags = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateLoadBalancer' {Maybe (NonEmpty Tag)
tags :: Maybe (NonEmpty Tag)
$sel:tags:CreateLoadBalancer' :: CreateLoadBalancer -> Maybe (NonEmpty Tag)
tags} -> Maybe (NonEmpty Tag)
tags) (\s :: CreateLoadBalancer
s@CreateLoadBalancer' {} Maybe (NonEmpty Tag)
a -> CreateLoadBalancer
s {$sel:tags:CreateLoadBalancer' :: Maybe (NonEmpty Tag)
tags = Maybe (NonEmpty Tag)
a} :: CreateLoadBalancer) 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 type of load balancer. The default is @application@.
createLoadBalancer_type :: Lens.Lens' CreateLoadBalancer (Prelude.Maybe LoadBalancerTypeEnum)
createLoadBalancer_type :: Lens' CreateLoadBalancer (Maybe LoadBalancerTypeEnum)
createLoadBalancer_type = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateLoadBalancer' {Maybe LoadBalancerTypeEnum
type' :: Maybe LoadBalancerTypeEnum
$sel:type':CreateLoadBalancer' :: CreateLoadBalancer -> Maybe LoadBalancerTypeEnum
type'} -> Maybe LoadBalancerTypeEnum
type') (\s :: CreateLoadBalancer
s@CreateLoadBalancer' {} Maybe LoadBalancerTypeEnum
a -> CreateLoadBalancer
s {$sel:type':CreateLoadBalancer' :: Maybe LoadBalancerTypeEnum
type' = Maybe LoadBalancerTypeEnum
a} :: CreateLoadBalancer)

-- | The name of the load balancer.
--
-- This name must be unique per region per account, can have a maximum of
-- 32 characters, must contain only alphanumeric characters or hyphens,
-- must not begin or end with a hyphen, and must not begin with
-- \"internal-\".
createLoadBalancer_name :: Lens.Lens' CreateLoadBalancer Prelude.Text
createLoadBalancer_name :: Lens' CreateLoadBalancer Text
createLoadBalancer_name = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateLoadBalancer' {Text
name :: Text
$sel:name:CreateLoadBalancer' :: CreateLoadBalancer -> Text
name} -> Text
name) (\s :: CreateLoadBalancer
s@CreateLoadBalancer' {} Text
a -> CreateLoadBalancer
s {$sel:name:CreateLoadBalancer' :: Text
name = Text
a} :: CreateLoadBalancer)

instance Core.AWSRequest CreateLoadBalancer where
  type
    AWSResponse CreateLoadBalancer =
      CreateLoadBalancerResponse
  request :: (Service -> Service)
-> CreateLoadBalancer -> Request CreateLoadBalancer
request Service -> Service
overrides =
    forall a. ToRequest a => Service -> a -> Request a
Request.postQuery (Service -> Service
overrides Service
defaultService)
  response :: forall (m :: * -> *).
MonadResource m =>
(ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy CreateLoadBalancer
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse CreateLoadBalancer)))
response =
    forall (m :: * -> *) a.
MonadResource m =>
Text
-> (Int
    -> ResponseHeaders -> [Node] -> Either String (AWSResponse a))
-> (ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy a
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse a)))
Response.receiveXMLWrapper
      Text
"CreateLoadBalancerResult"
      ( \Int
s ResponseHeaders
h [Node]
x ->
          Maybe [LoadBalancer] -> Int -> CreateLoadBalancerResponse
CreateLoadBalancerResponse'
            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
"LoadBalancers"
                            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.<*> (forall (f :: * -> *) a. Applicative f => a -> f a
Prelude.pure (forall a. Enum a => a -> Int
Prelude.fromEnum Int
s))
      )

instance Prelude.Hashable CreateLoadBalancer where
  hashWithSalt :: Int -> CreateLoadBalancer -> Int
hashWithSalt Int
_salt CreateLoadBalancer' {Maybe [Text]
Maybe [SubnetMapping]
Maybe (NonEmpty Tag)
Maybe Text
Maybe IpAddressType
Maybe LoadBalancerSchemeEnum
Maybe LoadBalancerTypeEnum
Text
name :: Text
type' :: Maybe LoadBalancerTypeEnum
tags :: Maybe (NonEmpty Tag)
subnets :: Maybe [Text]
subnetMappings :: Maybe [SubnetMapping]
securityGroups :: Maybe [Text]
scheme :: Maybe LoadBalancerSchemeEnum
ipAddressType :: Maybe IpAddressType
customerOwnedIpv4Pool :: Maybe Text
$sel:name:CreateLoadBalancer' :: CreateLoadBalancer -> Text
$sel:type':CreateLoadBalancer' :: CreateLoadBalancer -> Maybe LoadBalancerTypeEnum
$sel:tags:CreateLoadBalancer' :: CreateLoadBalancer -> Maybe (NonEmpty Tag)
$sel:subnets:CreateLoadBalancer' :: CreateLoadBalancer -> Maybe [Text]
$sel:subnetMappings:CreateLoadBalancer' :: CreateLoadBalancer -> Maybe [SubnetMapping]
$sel:securityGroups:CreateLoadBalancer' :: CreateLoadBalancer -> Maybe [Text]
$sel:scheme:CreateLoadBalancer' :: CreateLoadBalancer -> Maybe LoadBalancerSchemeEnum
$sel:ipAddressType:CreateLoadBalancer' :: CreateLoadBalancer -> Maybe IpAddressType
$sel:customerOwnedIpv4Pool:CreateLoadBalancer' :: CreateLoadBalancer -> Maybe Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
customerOwnedIpv4Pool
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe IpAddressType
ipAddressType
      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 [SubnetMapping]
subnetMappings
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [Text]
subnets
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe (NonEmpty Tag)
tags
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe LoadBalancerTypeEnum
type'
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
name

instance Prelude.NFData CreateLoadBalancer where
  rnf :: CreateLoadBalancer -> ()
rnf CreateLoadBalancer' {Maybe [Text]
Maybe [SubnetMapping]
Maybe (NonEmpty Tag)
Maybe Text
Maybe IpAddressType
Maybe LoadBalancerSchemeEnum
Maybe LoadBalancerTypeEnum
Text
name :: Text
type' :: Maybe LoadBalancerTypeEnum
tags :: Maybe (NonEmpty Tag)
subnets :: Maybe [Text]
subnetMappings :: Maybe [SubnetMapping]
securityGroups :: Maybe [Text]
scheme :: Maybe LoadBalancerSchemeEnum
ipAddressType :: Maybe IpAddressType
customerOwnedIpv4Pool :: Maybe Text
$sel:name:CreateLoadBalancer' :: CreateLoadBalancer -> Text
$sel:type':CreateLoadBalancer' :: CreateLoadBalancer -> Maybe LoadBalancerTypeEnum
$sel:tags:CreateLoadBalancer' :: CreateLoadBalancer -> Maybe (NonEmpty Tag)
$sel:subnets:CreateLoadBalancer' :: CreateLoadBalancer -> Maybe [Text]
$sel:subnetMappings:CreateLoadBalancer' :: CreateLoadBalancer -> Maybe [SubnetMapping]
$sel:securityGroups:CreateLoadBalancer' :: CreateLoadBalancer -> Maybe [Text]
$sel:scheme:CreateLoadBalancer' :: CreateLoadBalancer -> Maybe LoadBalancerSchemeEnum
$sel:ipAddressType:CreateLoadBalancer' :: CreateLoadBalancer -> Maybe IpAddressType
$sel:customerOwnedIpv4Pool:CreateLoadBalancer' :: CreateLoadBalancer -> Maybe Text
..} =
    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 IpAddressType
ipAddressType
      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 [SubnetMapping]
subnetMappings
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [Text]
subnets
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe (NonEmpty Tag)
tags
      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 Text
name

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

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

instance Data.ToQuery CreateLoadBalancer where
  toQuery :: CreateLoadBalancer -> QueryString
toQuery CreateLoadBalancer' {Maybe [Text]
Maybe [SubnetMapping]
Maybe (NonEmpty Tag)
Maybe Text
Maybe IpAddressType
Maybe LoadBalancerSchemeEnum
Maybe LoadBalancerTypeEnum
Text
name :: Text
type' :: Maybe LoadBalancerTypeEnum
tags :: Maybe (NonEmpty Tag)
subnets :: Maybe [Text]
subnetMappings :: Maybe [SubnetMapping]
securityGroups :: Maybe [Text]
scheme :: Maybe LoadBalancerSchemeEnum
ipAddressType :: Maybe IpAddressType
customerOwnedIpv4Pool :: Maybe Text
$sel:name:CreateLoadBalancer' :: CreateLoadBalancer -> Text
$sel:type':CreateLoadBalancer' :: CreateLoadBalancer -> Maybe LoadBalancerTypeEnum
$sel:tags:CreateLoadBalancer' :: CreateLoadBalancer -> Maybe (NonEmpty Tag)
$sel:subnets:CreateLoadBalancer' :: CreateLoadBalancer -> Maybe [Text]
$sel:subnetMappings:CreateLoadBalancer' :: CreateLoadBalancer -> Maybe [SubnetMapping]
$sel:securityGroups:CreateLoadBalancer' :: CreateLoadBalancer -> Maybe [Text]
$sel:scheme:CreateLoadBalancer' :: CreateLoadBalancer -> Maybe LoadBalancerSchemeEnum
$sel:ipAddressType:CreateLoadBalancer' :: CreateLoadBalancer -> Maybe IpAddressType
$sel:customerOwnedIpv4Pool:CreateLoadBalancer' :: CreateLoadBalancer -> Maybe Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"Action"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: (ByteString
"CreateLoadBalancer" :: Prelude.ByteString),
        ByteString
"Version"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: (ByteString
"2015-12-01" :: Prelude.ByteString),
        ByteString
"CustomerOwnedIpv4Pool"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Text
customerOwnedIpv4Pool,
        ByteString
"IpAddressType" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe IpAddressType
ipAddressType,
        ByteString
"Scheme" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe LoadBalancerSchemeEnum
scheme,
        ByteString
"SecurityGroups"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: forall a. ToQuery a => a -> QueryString
Data.toQuery
            ( forall a.
(IsList a, ToQuery (Item a)) =>
ByteString -> a -> QueryString
Data.toQueryList ByteString
"member"
                forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe [Text]
securityGroups
            ),
        ByteString
"SubnetMappings"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: forall a. ToQuery a => a -> QueryString
Data.toQuery
            ( forall a.
(IsList a, ToQuery (Item a)) =>
ByteString -> a -> QueryString
Data.toQueryList ByteString
"member"
                forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe [SubnetMapping]
subnetMappings
            ),
        ByteString
"Subnets"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: forall a. ToQuery a => a -> QueryString
Data.toQuery
            (forall a.
(IsList a, ToQuery (Item a)) =>
ByteString -> a -> QueryString
Data.toQueryList ByteString
"member" forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe [Text]
subnets),
        ByteString
"Tags"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: forall a. ToQuery a => a -> QueryString
Data.toQuery
            (forall a.
(IsList a, ToQuery (Item a)) =>
ByteString -> a -> QueryString
Data.toQueryList ByteString
"member" forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe (NonEmpty Tag)
tags),
        ByteString
"Type" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe LoadBalancerTypeEnum
type',
        ByteString
"Name" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Text
name
      ]

-- | /See:/ 'newCreateLoadBalancerResponse' smart constructor.
data CreateLoadBalancerResponse = CreateLoadBalancerResponse'
  { -- | Information about the load balancer.
    CreateLoadBalancerResponse -> Maybe [LoadBalancer]
loadBalancers :: Prelude.Maybe [LoadBalancer],
    -- | The response's http status code.
    CreateLoadBalancerResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (CreateLoadBalancerResponse -> CreateLoadBalancerResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateLoadBalancerResponse -> CreateLoadBalancerResponse -> Bool
$c/= :: CreateLoadBalancerResponse -> CreateLoadBalancerResponse -> Bool
== :: CreateLoadBalancerResponse -> CreateLoadBalancerResponse -> Bool
$c== :: CreateLoadBalancerResponse -> CreateLoadBalancerResponse -> Bool
Prelude.Eq, ReadPrec [CreateLoadBalancerResponse]
ReadPrec CreateLoadBalancerResponse
Int -> ReadS CreateLoadBalancerResponse
ReadS [CreateLoadBalancerResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CreateLoadBalancerResponse]
$creadListPrec :: ReadPrec [CreateLoadBalancerResponse]
readPrec :: ReadPrec CreateLoadBalancerResponse
$creadPrec :: ReadPrec CreateLoadBalancerResponse
readList :: ReadS [CreateLoadBalancerResponse]
$creadList :: ReadS [CreateLoadBalancerResponse]
readsPrec :: Int -> ReadS CreateLoadBalancerResponse
$creadsPrec :: Int -> ReadS CreateLoadBalancerResponse
Prelude.Read, Int -> CreateLoadBalancerResponse -> ShowS
[CreateLoadBalancerResponse] -> ShowS
CreateLoadBalancerResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateLoadBalancerResponse] -> ShowS
$cshowList :: [CreateLoadBalancerResponse] -> ShowS
show :: CreateLoadBalancerResponse -> String
$cshow :: CreateLoadBalancerResponse -> String
showsPrec :: Int -> CreateLoadBalancerResponse -> ShowS
$cshowsPrec :: Int -> CreateLoadBalancerResponse -> ShowS
Prelude.Show, forall x.
Rep CreateLoadBalancerResponse x -> CreateLoadBalancerResponse
forall x.
CreateLoadBalancerResponse -> Rep CreateLoadBalancerResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep CreateLoadBalancerResponse x -> CreateLoadBalancerResponse
$cfrom :: forall x.
CreateLoadBalancerResponse -> Rep CreateLoadBalancerResponse x
Prelude.Generic)

-- |
-- Create a value of 'CreateLoadBalancerResponse' 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:
--
-- 'loadBalancers', 'createLoadBalancerResponse_loadBalancers' - Information about the load balancer.
--
-- 'httpStatus', 'createLoadBalancerResponse_httpStatus' - The response's http status code.
newCreateLoadBalancerResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  CreateLoadBalancerResponse
newCreateLoadBalancerResponse :: Int -> CreateLoadBalancerResponse
newCreateLoadBalancerResponse Int
pHttpStatus_ =
  CreateLoadBalancerResponse'
    { $sel:loadBalancers:CreateLoadBalancerResponse' :: Maybe [LoadBalancer]
loadBalancers =
        forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:CreateLoadBalancerResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | Information about the load balancer.
createLoadBalancerResponse_loadBalancers :: Lens.Lens' CreateLoadBalancerResponse (Prelude.Maybe [LoadBalancer])
createLoadBalancerResponse_loadBalancers :: Lens' CreateLoadBalancerResponse (Maybe [LoadBalancer])
createLoadBalancerResponse_loadBalancers = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateLoadBalancerResponse' {Maybe [LoadBalancer]
loadBalancers :: Maybe [LoadBalancer]
$sel:loadBalancers:CreateLoadBalancerResponse' :: CreateLoadBalancerResponse -> Maybe [LoadBalancer]
loadBalancers} -> Maybe [LoadBalancer]
loadBalancers) (\s :: CreateLoadBalancerResponse
s@CreateLoadBalancerResponse' {} Maybe [LoadBalancer]
a -> CreateLoadBalancerResponse
s {$sel:loadBalancers:CreateLoadBalancerResponse' :: Maybe [LoadBalancer]
loadBalancers = Maybe [LoadBalancer]
a} :: CreateLoadBalancerResponse) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall (f :: * -> *) (g :: * -> *) s t a b.
(Functor f, Functor g) =>
AnIso s t a b -> Iso (f s) (g t) (f a) (g b)
Lens.mapping forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Lens.coerced

-- | The response's http status code.
createLoadBalancerResponse_httpStatus :: Lens.Lens' CreateLoadBalancerResponse Prelude.Int
createLoadBalancerResponse_httpStatus :: Lens' CreateLoadBalancerResponse Int
createLoadBalancerResponse_httpStatus = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateLoadBalancerResponse' {Int
httpStatus :: Int
$sel:httpStatus:CreateLoadBalancerResponse' :: CreateLoadBalancerResponse -> Int
httpStatus} -> Int
httpStatus) (\s :: CreateLoadBalancerResponse
s@CreateLoadBalancerResponse' {} Int
a -> CreateLoadBalancerResponse
s {$sel:httpStatus:CreateLoadBalancerResponse' :: Int
httpStatus = Int
a} :: CreateLoadBalancerResponse)

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