{-# 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.ELB.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 a Classic Load Balancer.
--
-- You can add listeners, security groups, subnets, and tags when you
-- create your load balancer, or you can add them later using
-- CreateLoadBalancerListeners, ApplySecurityGroupsToLoadBalancer,
-- AttachLoadBalancerToSubnets, and AddTags.
--
-- To describe your current load balancers, see DescribeLoadBalancers. When
-- you are finished with a load balancer, you can delete it using
-- DeleteLoadBalancer.
--
-- You can create up to 20 load balancers per region per account. You can
-- request an increase for the number of load balancers for your account.
-- For more information, see
-- <https://docs.aws.amazon.com/elasticloadbalancing/latest/classic/elb-limits.html Limits for Your Classic Load Balancer>
-- in the /Classic Load Balancers Guide/.
module Amazonka.ELB.CreateLoadBalancer
  ( -- * Creating a Request
    CreateLoadBalancer (..),
    newCreateLoadBalancer,

    -- * Request Lenses
    createLoadBalancer_availabilityZones,
    createLoadBalancer_scheme,
    createLoadBalancer_securityGroups,
    createLoadBalancer_subnets,
    createLoadBalancer_tags,
    createLoadBalancer_loadBalancerName,
    createLoadBalancer_listeners,

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

    -- * Response Lenses
    createLoadBalancerResponse_dNSName,
    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.ELB.Types
import qualified Amazonka.Prelude as Prelude
import qualified Amazonka.Request as Request
import qualified Amazonka.Response as Response

-- | Contains the parameters for CreateLoadBalancer.
--
-- /See:/ 'newCreateLoadBalancer' smart constructor.
data CreateLoadBalancer = CreateLoadBalancer'
  { -- | One or more Availability Zones from the same region as the load
    -- balancer.
    --
    -- You must specify at least one Availability Zone.
    --
    -- You can add more Availability Zones after you create the load balancer
    -- using EnableAvailabilityZonesForLoadBalancer.
    CreateLoadBalancer -> Maybe [Text]
availabilityZones :: Prelude.Maybe [Prelude.Text],
    -- | The type of a load balancer. Valid only for load balancers in a VPC.
    --
    -- By default, Elastic Load Balancing creates an Internet-facing load
    -- balancer with a DNS name that resolves to public IP addresses. For more
    -- information about Internet-facing and Internal load balancers, see
    -- <https://docs.aws.amazon.com/elasticloadbalancing/latest/userguide/how-elastic-load-balancing-works.html#load-balancer-scheme Load Balancer Scheme>
    -- in the /Elastic Load Balancing User Guide/.
    --
    -- Specify @internal@ to create a load balancer with a DNS name that
    -- resolves to private IP addresses.
    CreateLoadBalancer -> Maybe Text
scheme :: Prelude.Maybe Prelude.Text,
    -- | The IDs of the security groups to assign to the load balancer.
    CreateLoadBalancer -> Maybe [Text]
securityGroups :: Prelude.Maybe [Prelude.Text],
    -- | The IDs of the subnets in your VPC to attach to the load balancer.
    -- Specify one subnet per Availability Zone specified in
    -- @AvailabilityZones@.
    CreateLoadBalancer -> Maybe [Text]
subnets :: Prelude.Maybe [Prelude.Text],
    -- | A list of tags to assign to the load balancer.
    --
    -- For more information about tagging your load balancer, see
    -- <https://docs.aws.amazon.com/elasticloadbalancing/latest/classic/add-remove-tags.html Tag Your Classic Load Balancer>
    -- in the /Classic Load Balancers Guide/.
    CreateLoadBalancer -> Maybe (NonEmpty Tag)
tags :: Prelude.Maybe (Prelude.NonEmpty Tag),
    -- | The name of the load balancer.
    --
    -- This name must be unique within your set of load balancers for the
    -- region, must have a maximum of 32 characters, must contain only
    -- alphanumeric characters or hyphens, and cannot begin or end with a
    -- hyphen.
    CreateLoadBalancer -> Text
loadBalancerName :: Prelude.Text,
    -- | The listeners.
    --
    -- For more information, see
    -- <https://docs.aws.amazon.com/elasticloadbalancing/latest/classic/elb-listener-config.html Listeners for Your Classic Load Balancer>
    -- in the /Classic Load Balancers Guide/.
    CreateLoadBalancer -> [Listener]
listeners :: [Listener]
  }
  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:
--
-- 'availabilityZones', 'createLoadBalancer_availabilityZones' - One or more Availability Zones from the same region as the load
-- balancer.
--
-- You must specify at least one Availability Zone.
--
-- You can add more Availability Zones after you create the load balancer
-- using EnableAvailabilityZonesForLoadBalancer.
--
-- 'scheme', 'createLoadBalancer_scheme' - The type of a load balancer. Valid only for load balancers in a VPC.
--
-- By default, Elastic Load Balancing creates an Internet-facing load
-- balancer with a DNS name that resolves to public IP addresses. For more
-- information about Internet-facing and Internal load balancers, see
-- <https://docs.aws.amazon.com/elasticloadbalancing/latest/userguide/how-elastic-load-balancing-works.html#load-balancer-scheme Load Balancer Scheme>
-- in the /Elastic Load Balancing User Guide/.
--
-- Specify @internal@ to create a load balancer with a DNS name that
-- resolves to private IP addresses.
--
-- 'securityGroups', 'createLoadBalancer_securityGroups' - The IDs of the security groups to assign to the load balancer.
--
-- 'subnets', 'createLoadBalancer_subnets' - The IDs of the subnets in your VPC to attach to the load balancer.
-- Specify one subnet per Availability Zone specified in
-- @AvailabilityZones@.
--
-- 'tags', 'createLoadBalancer_tags' - A list of tags to assign to the load balancer.
--
-- For more information about tagging your load balancer, see
-- <https://docs.aws.amazon.com/elasticloadbalancing/latest/classic/add-remove-tags.html Tag Your Classic Load Balancer>
-- in the /Classic Load Balancers Guide/.
--
-- 'loadBalancerName', 'createLoadBalancer_loadBalancerName' - The name of the load balancer.
--
-- This name must be unique within your set of load balancers for the
-- region, must have a maximum of 32 characters, must contain only
-- alphanumeric characters or hyphens, and cannot begin or end with a
-- hyphen.
--
-- 'listeners', 'createLoadBalancer_listeners' - The listeners.
--
-- For more information, see
-- <https://docs.aws.amazon.com/elasticloadbalancing/latest/classic/elb-listener-config.html Listeners for Your Classic Load Balancer>
-- in the /Classic Load Balancers Guide/.
newCreateLoadBalancer ::
  -- | 'loadBalancerName'
  Prelude.Text ->
  CreateLoadBalancer
newCreateLoadBalancer :: Text -> CreateLoadBalancer
newCreateLoadBalancer Text
pLoadBalancerName_ =
  CreateLoadBalancer'
    { $sel:availabilityZones:CreateLoadBalancer' :: Maybe [Text]
availabilityZones =
        forall a. Maybe a
Prelude.Nothing,
      $sel:scheme:CreateLoadBalancer' :: Maybe Text
scheme = forall a. Maybe a
Prelude.Nothing,
      $sel:securityGroups:CreateLoadBalancer' :: Maybe [Text]
securityGroups = 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:loadBalancerName:CreateLoadBalancer' :: Text
loadBalancerName = Text
pLoadBalancerName_,
      $sel:listeners:CreateLoadBalancer' :: [Listener]
listeners = forall a. Monoid a => a
Prelude.mempty
    }

-- | One or more Availability Zones from the same region as the load
-- balancer.
--
-- You must specify at least one Availability Zone.
--
-- You can add more Availability Zones after you create the load balancer
-- using EnableAvailabilityZonesForLoadBalancer.
createLoadBalancer_availabilityZones :: Lens.Lens' CreateLoadBalancer (Prelude.Maybe [Prelude.Text])
createLoadBalancer_availabilityZones :: Lens' CreateLoadBalancer (Maybe [Text])
createLoadBalancer_availabilityZones = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateLoadBalancer' {Maybe [Text]
availabilityZones :: Maybe [Text]
$sel:availabilityZones:CreateLoadBalancer' :: CreateLoadBalancer -> Maybe [Text]
availabilityZones} -> Maybe [Text]
availabilityZones) (\s :: CreateLoadBalancer
s@CreateLoadBalancer' {} Maybe [Text]
a -> CreateLoadBalancer
s {$sel:availabilityZones:CreateLoadBalancer' :: Maybe [Text]
availabilityZones = 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 type of a load balancer. Valid only for load balancers in a VPC.
--
-- By default, Elastic Load Balancing creates an Internet-facing load
-- balancer with a DNS name that resolves to public IP addresses. For more
-- information about Internet-facing and Internal load balancers, see
-- <https://docs.aws.amazon.com/elasticloadbalancing/latest/userguide/how-elastic-load-balancing-works.html#load-balancer-scheme Load Balancer Scheme>
-- in the /Elastic Load Balancing User Guide/.
--
-- Specify @internal@ to create a load balancer with a DNS name that
-- resolves to private IP addresses.
createLoadBalancer_scheme :: Lens.Lens' CreateLoadBalancer (Prelude.Maybe Prelude.Text)
createLoadBalancer_scheme :: Lens' CreateLoadBalancer (Maybe Text)
createLoadBalancer_scheme = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateLoadBalancer' {Maybe Text
scheme :: Maybe Text
$sel:scheme:CreateLoadBalancer' :: CreateLoadBalancer -> Maybe Text
scheme} -> Maybe Text
scheme) (\s :: CreateLoadBalancer
s@CreateLoadBalancer' {} Maybe Text
a -> CreateLoadBalancer
s {$sel:scheme:CreateLoadBalancer' :: Maybe Text
scheme = Maybe Text
a} :: CreateLoadBalancer)

-- | The IDs of the security groups to assign to 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 subnets in your VPC to attach to the load balancer.
-- Specify one subnet per Availability Zone specified in
-- @AvailabilityZones@.
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

-- | A list of tags to assign to the load balancer.
--
-- For more information about tagging your load balancer, see
-- <https://docs.aws.amazon.com/elasticloadbalancing/latest/classic/add-remove-tags.html Tag Your Classic Load Balancer>
-- in the /Classic Load Balancers Guide/.
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 name of the load balancer.
--
-- This name must be unique within your set of load balancers for the
-- region, must have a maximum of 32 characters, must contain only
-- alphanumeric characters or hyphens, and cannot begin or end with a
-- hyphen.
createLoadBalancer_loadBalancerName :: Lens.Lens' CreateLoadBalancer Prelude.Text
createLoadBalancer_loadBalancerName :: Lens' CreateLoadBalancer Text
createLoadBalancer_loadBalancerName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateLoadBalancer' {Text
loadBalancerName :: Text
$sel:loadBalancerName:CreateLoadBalancer' :: CreateLoadBalancer -> Text
loadBalancerName} -> Text
loadBalancerName) (\s :: CreateLoadBalancer
s@CreateLoadBalancer' {} Text
a -> CreateLoadBalancer
s {$sel:loadBalancerName:CreateLoadBalancer' :: Text
loadBalancerName = Text
a} :: CreateLoadBalancer)

-- | The listeners.
--
-- For more information, see
-- <https://docs.aws.amazon.com/elasticloadbalancing/latest/classic/elb-listener-config.html Listeners for Your Classic Load Balancer>
-- in the /Classic Load Balancers Guide/.
createLoadBalancer_listeners :: Lens.Lens' CreateLoadBalancer [Listener]
createLoadBalancer_listeners :: Lens' CreateLoadBalancer [Listener]
createLoadBalancer_listeners = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateLoadBalancer' {[Listener]
listeners :: [Listener]
$sel:listeners:CreateLoadBalancer' :: CreateLoadBalancer -> [Listener]
listeners} -> [Listener]
listeners) (\s :: CreateLoadBalancer
s@CreateLoadBalancer' {} [Listener]
a -> CreateLoadBalancer
s {$sel:listeners:CreateLoadBalancer' :: [Listener]
listeners = [Listener]
a} :: CreateLoadBalancer) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Lens.coerced

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 Text -> 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
"DNSName")
            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' {[Listener]
Maybe [Text]
Maybe (NonEmpty Tag)
Maybe Text
Text
listeners :: [Listener]
loadBalancerName :: Text
tags :: Maybe (NonEmpty Tag)
subnets :: Maybe [Text]
securityGroups :: Maybe [Text]
scheme :: Maybe Text
availabilityZones :: Maybe [Text]
$sel:listeners:CreateLoadBalancer' :: CreateLoadBalancer -> [Listener]
$sel:loadBalancerName:CreateLoadBalancer' :: CreateLoadBalancer -> Text
$sel:tags:CreateLoadBalancer' :: CreateLoadBalancer -> Maybe (NonEmpty Tag)
$sel:subnets:CreateLoadBalancer' :: CreateLoadBalancer -> Maybe [Text]
$sel:securityGroups:CreateLoadBalancer' :: CreateLoadBalancer -> Maybe [Text]
$sel:scheme:CreateLoadBalancer' :: CreateLoadBalancer -> Maybe Text
$sel:availabilityZones:CreateLoadBalancer' :: CreateLoadBalancer -> Maybe [Text]
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [Text]
availabilityZones
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
scheme
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [Text]
securityGroups
      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` Text
loadBalancerName
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` [Listener]
listeners

instance Prelude.NFData CreateLoadBalancer where
  rnf :: CreateLoadBalancer -> ()
rnf CreateLoadBalancer' {[Listener]
Maybe [Text]
Maybe (NonEmpty Tag)
Maybe Text
Text
listeners :: [Listener]
loadBalancerName :: Text
tags :: Maybe (NonEmpty Tag)
subnets :: Maybe [Text]
securityGroups :: Maybe [Text]
scheme :: Maybe Text
availabilityZones :: Maybe [Text]
$sel:listeners:CreateLoadBalancer' :: CreateLoadBalancer -> [Listener]
$sel:loadBalancerName:CreateLoadBalancer' :: CreateLoadBalancer -> Text
$sel:tags:CreateLoadBalancer' :: CreateLoadBalancer -> Maybe (NonEmpty Tag)
$sel:subnets:CreateLoadBalancer' :: CreateLoadBalancer -> Maybe [Text]
$sel:securityGroups:CreateLoadBalancer' :: CreateLoadBalancer -> Maybe [Text]
$sel:scheme:CreateLoadBalancer' :: CreateLoadBalancer -> Maybe Text
$sel:availabilityZones:CreateLoadBalancer' :: CreateLoadBalancer -> Maybe [Text]
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe [Text]
availabilityZones
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
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 [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 Text
loadBalancerName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf [Listener]
listeners

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' {[Listener]
Maybe [Text]
Maybe (NonEmpty Tag)
Maybe Text
Text
listeners :: [Listener]
loadBalancerName :: Text
tags :: Maybe (NonEmpty Tag)
subnets :: Maybe [Text]
securityGroups :: Maybe [Text]
scheme :: Maybe Text
availabilityZones :: Maybe [Text]
$sel:listeners:CreateLoadBalancer' :: CreateLoadBalancer -> [Listener]
$sel:loadBalancerName:CreateLoadBalancer' :: CreateLoadBalancer -> Text
$sel:tags:CreateLoadBalancer' :: CreateLoadBalancer -> Maybe (NonEmpty Tag)
$sel:subnets:CreateLoadBalancer' :: CreateLoadBalancer -> Maybe [Text]
$sel:securityGroups:CreateLoadBalancer' :: CreateLoadBalancer -> Maybe [Text]
$sel:scheme:CreateLoadBalancer' :: CreateLoadBalancer -> Maybe Text
$sel:availabilityZones: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
"2012-06-01" :: Prelude.ByteString),
        ByteString
"AvailabilityZones"
          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]
availabilityZones
            ),
        ByteString
"Scheme" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Text
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
"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
"LoadBalancerName" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Text
loadBalancerName,
        ByteString
"Listeners"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: forall a.
(IsList a, ToQuery (Item a)) =>
ByteString -> a -> QueryString
Data.toQueryList ByteString
"member" [Listener]
listeners
      ]

-- | Contains the output for CreateLoadBalancer.
--
-- /See:/ 'newCreateLoadBalancerResponse' smart constructor.
data CreateLoadBalancerResponse = CreateLoadBalancerResponse'
  { -- | The DNS name of the load balancer.
    CreateLoadBalancerResponse -> Maybe Text
dNSName :: Prelude.Maybe Prelude.Text,
    -- | 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:
--
-- 'dNSName', 'createLoadBalancerResponse_dNSName' - The DNS name of 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:dNSName:CreateLoadBalancerResponse' :: Maybe Text
dNSName =
        forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:CreateLoadBalancerResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

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

-- | 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 Text
httpStatus :: Int
dNSName :: Maybe Text
$sel:httpStatus:CreateLoadBalancerResponse' :: CreateLoadBalancerResponse -> Int
$sel:dNSName:CreateLoadBalancerResponse' :: CreateLoadBalancerResponse -> Maybe Text
..} =
    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 Int
httpStatus