{-# 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.OpsWorks.AttachElasticLoadBalancer
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Attaches an Elastic Load Balancing load balancer to a specified layer.
-- AWS OpsWorks Stacks does not support Application Load Balancer. You can
-- only use Classic Load Balancer with AWS OpsWorks Stacks. For more
-- information, see
-- <https://docs.aws.amazon.com/opsworks/latest/userguide/layers-elb.html Elastic Load Balancing>.
--
-- You must create the Elastic Load Balancing instance separately, by using
-- the Elastic Load Balancing console, API, or CLI. For more information,
-- see
-- <https://docs.aws.amazon.com/ElasticLoadBalancing/latest/DeveloperGuide/Welcome.html Elastic Load Balancing Developer Guide>.
--
-- __Required Permissions__: To use this action, an IAM user must have a
-- Manage permissions level for the stack, or an attached policy that
-- explicitly grants permissions. For more information on user permissions,
-- see
-- <https://docs.aws.amazon.com/opsworks/latest/userguide/opsworks-security-users.html Managing User Permissions>.
module Amazonka.OpsWorks.AttachElasticLoadBalancer
  ( -- * Creating a Request
    AttachElasticLoadBalancer (..),
    newAttachElasticLoadBalancer,

    -- * Request Lenses
    attachElasticLoadBalancer_elasticLoadBalancerName,
    attachElasticLoadBalancer_layerId,

    -- * Destructuring the Response
    AttachElasticLoadBalancerResponse (..),
    newAttachElasticLoadBalancerResponse,
  )
where

import qualified Amazonka.Core as Core
import qualified Amazonka.Core.Lens.Internal as Lens
import qualified Amazonka.Data as Data
import Amazonka.OpsWorks.Types
import qualified Amazonka.Prelude as Prelude
import qualified Amazonka.Request as Request
import qualified Amazonka.Response as Response

-- | /See:/ 'newAttachElasticLoadBalancer' smart constructor.
data AttachElasticLoadBalancer = AttachElasticLoadBalancer'
  { -- | The Elastic Load Balancing instance\'s name.
    AttachElasticLoadBalancer -> Text
elasticLoadBalancerName :: Prelude.Text,
    -- | The ID of the layer to which the Elastic Load Balancing instance is to
    -- be attached.
    AttachElasticLoadBalancer -> Text
layerId :: Prelude.Text
  }
  deriving (AttachElasticLoadBalancer -> AttachElasticLoadBalancer -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AttachElasticLoadBalancer -> AttachElasticLoadBalancer -> Bool
$c/= :: AttachElasticLoadBalancer -> AttachElasticLoadBalancer -> Bool
== :: AttachElasticLoadBalancer -> AttachElasticLoadBalancer -> Bool
$c== :: AttachElasticLoadBalancer -> AttachElasticLoadBalancer -> Bool
Prelude.Eq, ReadPrec [AttachElasticLoadBalancer]
ReadPrec AttachElasticLoadBalancer
Int -> ReadS AttachElasticLoadBalancer
ReadS [AttachElasticLoadBalancer]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [AttachElasticLoadBalancer]
$creadListPrec :: ReadPrec [AttachElasticLoadBalancer]
readPrec :: ReadPrec AttachElasticLoadBalancer
$creadPrec :: ReadPrec AttachElasticLoadBalancer
readList :: ReadS [AttachElasticLoadBalancer]
$creadList :: ReadS [AttachElasticLoadBalancer]
readsPrec :: Int -> ReadS AttachElasticLoadBalancer
$creadsPrec :: Int -> ReadS AttachElasticLoadBalancer
Prelude.Read, Int -> AttachElasticLoadBalancer -> ShowS
[AttachElasticLoadBalancer] -> ShowS
AttachElasticLoadBalancer -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AttachElasticLoadBalancer] -> ShowS
$cshowList :: [AttachElasticLoadBalancer] -> ShowS
show :: AttachElasticLoadBalancer -> String
$cshow :: AttachElasticLoadBalancer -> String
showsPrec :: Int -> AttachElasticLoadBalancer -> ShowS
$cshowsPrec :: Int -> AttachElasticLoadBalancer -> ShowS
Prelude.Show, forall x.
Rep AttachElasticLoadBalancer x -> AttachElasticLoadBalancer
forall x.
AttachElasticLoadBalancer -> Rep AttachElasticLoadBalancer x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep AttachElasticLoadBalancer x -> AttachElasticLoadBalancer
$cfrom :: forall x.
AttachElasticLoadBalancer -> Rep AttachElasticLoadBalancer x
Prelude.Generic)

-- |
-- Create a value of 'AttachElasticLoadBalancer' 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:
--
-- 'elasticLoadBalancerName', 'attachElasticLoadBalancer_elasticLoadBalancerName' - The Elastic Load Balancing instance\'s name.
--
-- 'layerId', 'attachElasticLoadBalancer_layerId' - The ID of the layer to which the Elastic Load Balancing instance is to
-- be attached.
newAttachElasticLoadBalancer ::
  -- | 'elasticLoadBalancerName'
  Prelude.Text ->
  -- | 'layerId'
  Prelude.Text ->
  AttachElasticLoadBalancer
newAttachElasticLoadBalancer :: Text -> Text -> AttachElasticLoadBalancer
newAttachElasticLoadBalancer
  Text
pElasticLoadBalancerName_
  Text
pLayerId_ =
    AttachElasticLoadBalancer'
      { $sel:elasticLoadBalancerName:AttachElasticLoadBalancer' :: Text
elasticLoadBalancerName =
          Text
pElasticLoadBalancerName_,
        $sel:layerId:AttachElasticLoadBalancer' :: Text
layerId = Text
pLayerId_
      }

-- | The Elastic Load Balancing instance\'s name.
attachElasticLoadBalancer_elasticLoadBalancerName :: Lens.Lens' AttachElasticLoadBalancer Prelude.Text
attachElasticLoadBalancer_elasticLoadBalancerName :: Lens' AttachElasticLoadBalancer Text
attachElasticLoadBalancer_elasticLoadBalancerName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\AttachElasticLoadBalancer' {Text
elasticLoadBalancerName :: Text
$sel:elasticLoadBalancerName:AttachElasticLoadBalancer' :: AttachElasticLoadBalancer -> Text
elasticLoadBalancerName} -> Text
elasticLoadBalancerName) (\s :: AttachElasticLoadBalancer
s@AttachElasticLoadBalancer' {} Text
a -> AttachElasticLoadBalancer
s {$sel:elasticLoadBalancerName:AttachElasticLoadBalancer' :: Text
elasticLoadBalancerName = Text
a} :: AttachElasticLoadBalancer)

-- | The ID of the layer to which the Elastic Load Balancing instance is to
-- be attached.
attachElasticLoadBalancer_layerId :: Lens.Lens' AttachElasticLoadBalancer Prelude.Text
attachElasticLoadBalancer_layerId :: Lens' AttachElasticLoadBalancer Text
attachElasticLoadBalancer_layerId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\AttachElasticLoadBalancer' {Text
layerId :: Text
$sel:layerId:AttachElasticLoadBalancer' :: AttachElasticLoadBalancer -> Text
layerId} -> Text
layerId) (\s :: AttachElasticLoadBalancer
s@AttachElasticLoadBalancer' {} Text
a -> AttachElasticLoadBalancer
s {$sel:layerId:AttachElasticLoadBalancer' :: Text
layerId = Text
a} :: AttachElasticLoadBalancer)

instance Core.AWSRequest AttachElasticLoadBalancer where
  type
    AWSResponse AttachElasticLoadBalancer =
      AttachElasticLoadBalancerResponse
  request :: (Service -> Service)
-> AttachElasticLoadBalancer -> Request AttachElasticLoadBalancer
request Service -> Service
overrides =
    forall a. (ToRequest a, ToJSON a) => Service -> a -> Request a
Request.postJSON (Service -> Service
overrides Service
defaultService)
  response :: forall (m :: * -> *).
MonadResource m =>
(ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy AttachElasticLoadBalancer
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse AttachElasticLoadBalancer)))
response =
    forall (m :: * -> *) a.
MonadResource m =>
AWSResponse a
-> (ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy a
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse a)))
Response.receiveNull
      AttachElasticLoadBalancerResponse
AttachElasticLoadBalancerResponse'

instance Prelude.Hashable AttachElasticLoadBalancer where
  hashWithSalt :: Int -> AttachElasticLoadBalancer -> Int
hashWithSalt Int
_salt AttachElasticLoadBalancer' {Text
layerId :: Text
elasticLoadBalancerName :: Text
$sel:layerId:AttachElasticLoadBalancer' :: AttachElasticLoadBalancer -> Text
$sel:elasticLoadBalancerName:AttachElasticLoadBalancer' :: AttachElasticLoadBalancer -> Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
elasticLoadBalancerName
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
layerId

instance Prelude.NFData AttachElasticLoadBalancer where
  rnf :: AttachElasticLoadBalancer -> ()
rnf AttachElasticLoadBalancer' {Text
layerId :: Text
elasticLoadBalancerName :: Text
$sel:layerId:AttachElasticLoadBalancer' :: AttachElasticLoadBalancer -> Text
$sel:elasticLoadBalancerName:AttachElasticLoadBalancer' :: AttachElasticLoadBalancer -> Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Text
elasticLoadBalancerName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
layerId

instance Data.ToHeaders AttachElasticLoadBalancer where
  toHeaders :: AttachElasticLoadBalancer -> [Header]
toHeaders =
    forall a b. a -> b -> a
Prelude.const
      ( forall a. Monoid a => [a] -> a
Prelude.mconcat
          [ HeaderName
"X-Amz-Target"
              forall a. ToHeader a => HeaderName -> a -> [Header]
Data.=# ( ByteString
"OpsWorks_20130218.AttachElasticLoadBalancer" ::
                          Prelude.ByteString
                      ),
            HeaderName
"Content-Type"
              forall a. ToHeader a => HeaderName -> a -> [Header]
Data.=# ( ByteString
"application/x-amz-json-1.1" ::
                          Prelude.ByteString
                      )
          ]
      )

instance Data.ToJSON AttachElasticLoadBalancer where
  toJSON :: AttachElasticLoadBalancer -> Value
toJSON AttachElasticLoadBalancer' {Text
layerId :: Text
elasticLoadBalancerName :: Text
$sel:layerId:AttachElasticLoadBalancer' :: AttachElasticLoadBalancer -> Text
$sel:elasticLoadBalancerName:AttachElasticLoadBalancer' :: AttachElasticLoadBalancer -> Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ forall a. a -> Maybe a
Prelude.Just
              ( Key
"ElasticLoadBalancerName"
                  forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
elasticLoadBalancerName
              ),
            forall a. a -> Maybe a
Prelude.Just (Key
"LayerId" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
layerId)
          ]
      )

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

instance Data.ToQuery AttachElasticLoadBalancer where
  toQuery :: AttachElasticLoadBalancer -> QueryString
toQuery = forall a b. a -> b -> a
Prelude.const forall a. Monoid a => a
Prelude.mempty

-- | /See:/ 'newAttachElasticLoadBalancerResponse' smart constructor.
data AttachElasticLoadBalancerResponse = AttachElasticLoadBalancerResponse'
  {
  }
  deriving (AttachElasticLoadBalancerResponse
-> AttachElasticLoadBalancerResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AttachElasticLoadBalancerResponse
-> AttachElasticLoadBalancerResponse -> Bool
$c/= :: AttachElasticLoadBalancerResponse
-> AttachElasticLoadBalancerResponse -> Bool
== :: AttachElasticLoadBalancerResponse
-> AttachElasticLoadBalancerResponse -> Bool
$c== :: AttachElasticLoadBalancerResponse
-> AttachElasticLoadBalancerResponse -> Bool
Prelude.Eq, ReadPrec [AttachElasticLoadBalancerResponse]
ReadPrec AttachElasticLoadBalancerResponse
Int -> ReadS AttachElasticLoadBalancerResponse
ReadS [AttachElasticLoadBalancerResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [AttachElasticLoadBalancerResponse]
$creadListPrec :: ReadPrec [AttachElasticLoadBalancerResponse]
readPrec :: ReadPrec AttachElasticLoadBalancerResponse
$creadPrec :: ReadPrec AttachElasticLoadBalancerResponse
readList :: ReadS [AttachElasticLoadBalancerResponse]
$creadList :: ReadS [AttachElasticLoadBalancerResponse]
readsPrec :: Int -> ReadS AttachElasticLoadBalancerResponse
$creadsPrec :: Int -> ReadS AttachElasticLoadBalancerResponse
Prelude.Read, Int -> AttachElasticLoadBalancerResponse -> ShowS
[AttachElasticLoadBalancerResponse] -> ShowS
AttachElasticLoadBalancerResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AttachElasticLoadBalancerResponse] -> ShowS
$cshowList :: [AttachElasticLoadBalancerResponse] -> ShowS
show :: AttachElasticLoadBalancerResponse -> String
$cshow :: AttachElasticLoadBalancerResponse -> String
showsPrec :: Int -> AttachElasticLoadBalancerResponse -> ShowS
$cshowsPrec :: Int -> AttachElasticLoadBalancerResponse -> ShowS
Prelude.Show, forall x.
Rep AttachElasticLoadBalancerResponse x
-> AttachElasticLoadBalancerResponse
forall x.
AttachElasticLoadBalancerResponse
-> Rep AttachElasticLoadBalancerResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep AttachElasticLoadBalancerResponse x
-> AttachElasticLoadBalancerResponse
$cfrom :: forall x.
AttachElasticLoadBalancerResponse
-> Rep AttachElasticLoadBalancerResponse x
Prelude.Generic)

-- |
-- Create a value of 'AttachElasticLoadBalancerResponse' 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.
newAttachElasticLoadBalancerResponse ::
  AttachElasticLoadBalancerResponse
newAttachElasticLoadBalancerResponse :: AttachElasticLoadBalancerResponse
newAttachElasticLoadBalancerResponse =
  AttachElasticLoadBalancerResponse
AttachElasticLoadBalancerResponse'

instance
  Prelude.NFData
    AttachElasticLoadBalancerResponse
  where
  rnf :: AttachElasticLoadBalancerResponse -> ()
rnf AttachElasticLoadBalancerResponse
_ = ()