{-# 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.Lightsail.UpdateLoadBalancerAttribute
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Updates the specified attribute for a load balancer. You can only update
-- one attribute at a time.
--
-- The @update load balancer attribute@ operation supports tag-based access
-- control via resource tags applied to the resource identified by
-- @load balancer name@. For more information, see the
-- <https://lightsail.aws.amazon.com/ls/docs/en_us/articles/amazon-lightsail-controlling-access-using-tags Amazon Lightsail Developer Guide>.
module Amazonka.Lightsail.UpdateLoadBalancerAttribute
  ( -- * Creating a Request
    UpdateLoadBalancerAttribute (..),
    newUpdateLoadBalancerAttribute,

    -- * Request Lenses
    updateLoadBalancerAttribute_loadBalancerName,
    updateLoadBalancerAttribute_attributeName,
    updateLoadBalancerAttribute_attributeValue,

    -- * Destructuring the Response
    UpdateLoadBalancerAttributeResponse (..),
    newUpdateLoadBalancerAttributeResponse,

    -- * Response Lenses
    updateLoadBalancerAttributeResponse_operations,
    updateLoadBalancerAttributeResponse_httpStatus,
  )
where

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

-- | /See:/ 'newUpdateLoadBalancerAttribute' smart constructor.
data UpdateLoadBalancerAttribute = UpdateLoadBalancerAttribute'
  { -- | The name of the load balancer that you want to modify (e.g.,
    -- @my-load-balancer@.
    UpdateLoadBalancerAttribute -> Text
loadBalancerName :: Prelude.Text,
    -- | The name of the attribute you want to update.
    UpdateLoadBalancerAttribute -> LoadBalancerAttributeName
attributeName :: LoadBalancerAttributeName,
    -- | The value that you want to specify for the attribute name.
    --
    -- The following values are supported depending on what you specify for the
    -- @attributeName@ request parameter:
    --
    -- -   If you specify @HealthCheckPath@ for the @attributeName@ request
    --     parameter, then the @attributeValue@ request parameter must be the
    --     path to ping on the target (for example,
    --     @\/weather\/us\/wa\/seattle@).
    --
    -- -   If you specify @SessionStickinessEnabled@ for the @attributeName@
    --     request parameter, then the @attributeValue@ request parameter must
    --     be @true@ to activate session stickiness or @false@ to deactivate
    --     session stickiness.
    --
    -- -   If you specify @SessionStickiness_LB_CookieDurationSeconds@ for the
    --     @attributeName@ request parameter, then the @attributeValue@ request
    --     parameter must be an interger that represents the cookie duration in
    --     seconds.
    --
    -- -   If you specify @HttpsRedirectionEnabled@ for the @attributeName@
    --     request parameter, then the @attributeValue@ request parameter must
    --     be @true@ to activate HTTP to HTTPS redirection or @false@ to
    --     deactivate HTTP to HTTPS redirection.
    --
    -- -   If you specify @TlsPolicyName@ for the @attributeName@ request
    --     parameter, then the @attributeValue@ request parameter must be the
    --     name of the TLS policy.
    --
    --     Use the
    --     <https://docs.aws.amazon.com/lightsail/2016-11-28/api-reference/API_GetLoadBalancerTlsPolicies.html GetLoadBalancerTlsPolicies>
    --     action to get a list of TLS policy names that you can specify.
    UpdateLoadBalancerAttribute -> Text
attributeValue :: Prelude.Text
  }
  deriving (UpdateLoadBalancerAttribute -> UpdateLoadBalancerAttribute -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UpdateLoadBalancerAttribute -> UpdateLoadBalancerAttribute -> Bool
$c/= :: UpdateLoadBalancerAttribute -> UpdateLoadBalancerAttribute -> Bool
== :: UpdateLoadBalancerAttribute -> UpdateLoadBalancerAttribute -> Bool
$c== :: UpdateLoadBalancerAttribute -> UpdateLoadBalancerAttribute -> Bool
Prelude.Eq, ReadPrec [UpdateLoadBalancerAttribute]
ReadPrec UpdateLoadBalancerAttribute
Int -> ReadS UpdateLoadBalancerAttribute
ReadS [UpdateLoadBalancerAttribute]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [UpdateLoadBalancerAttribute]
$creadListPrec :: ReadPrec [UpdateLoadBalancerAttribute]
readPrec :: ReadPrec UpdateLoadBalancerAttribute
$creadPrec :: ReadPrec UpdateLoadBalancerAttribute
readList :: ReadS [UpdateLoadBalancerAttribute]
$creadList :: ReadS [UpdateLoadBalancerAttribute]
readsPrec :: Int -> ReadS UpdateLoadBalancerAttribute
$creadsPrec :: Int -> ReadS UpdateLoadBalancerAttribute
Prelude.Read, Int -> UpdateLoadBalancerAttribute -> ShowS
[UpdateLoadBalancerAttribute] -> ShowS
UpdateLoadBalancerAttribute -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UpdateLoadBalancerAttribute] -> ShowS
$cshowList :: [UpdateLoadBalancerAttribute] -> ShowS
show :: UpdateLoadBalancerAttribute -> String
$cshow :: UpdateLoadBalancerAttribute -> String
showsPrec :: Int -> UpdateLoadBalancerAttribute -> ShowS
$cshowsPrec :: Int -> UpdateLoadBalancerAttribute -> ShowS
Prelude.Show, forall x.
Rep UpdateLoadBalancerAttribute x -> UpdateLoadBalancerAttribute
forall x.
UpdateLoadBalancerAttribute -> Rep UpdateLoadBalancerAttribute x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep UpdateLoadBalancerAttribute x -> UpdateLoadBalancerAttribute
$cfrom :: forall x.
UpdateLoadBalancerAttribute -> Rep UpdateLoadBalancerAttribute x
Prelude.Generic)

-- |
-- Create a value of 'UpdateLoadBalancerAttribute' 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:
--
-- 'loadBalancerName', 'updateLoadBalancerAttribute_loadBalancerName' - The name of the load balancer that you want to modify (e.g.,
-- @my-load-balancer@.
--
-- 'attributeName', 'updateLoadBalancerAttribute_attributeName' - The name of the attribute you want to update.
--
-- 'attributeValue', 'updateLoadBalancerAttribute_attributeValue' - The value that you want to specify for the attribute name.
--
-- The following values are supported depending on what you specify for the
-- @attributeName@ request parameter:
--
-- -   If you specify @HealthCheckPath@ for the @attributeName@ request
--     parameter, then the @attributeValue@ request parameter must be the
--     path to ping on the target (for example,
--     @\/weather\/us\/wa\/seattle@).
--
-- -   If you specify @SessionStickinessEnabled@ for the @attributeName@
--     request parameter, then the @attributeValue@ request parameter must
--     be @true@ to activate session stickiness or @false@ to deactivate
--     session stickiness.
--
-- -   If you specify @SessionStickiness_LB_CookieDurationSeconds@ for the
--     @attributeName@ request parameter, then the @attributeValue@ request
--     parameter must be an interger that represents the cookie duration in
--     seconds.
--
-- -   If you specify @HttpsRedirectionEnabled@ for the @attributeName@
--     request parameter, then the @attributeValue@ request parameter must
--     be @true@ to activate HTTP to HTTPS redirection or @false@ to
--     deactivate HTTP to HTTPS redirection.
--
-- -   If you specify @TlsPolicyName@ for the @attributeName@ request
--     parameter, then the @attributeValue@ request parameter must be the
--     name of the TLS policy.
--
--     Use the
--     <https://docs.aws.amazon.com/lightsail/2016-11-28/api-reference/API_GetLoadBalancerTlsPolicies.html GetLoadBalancerTlsPolicies>
--     action to get a list of TLS policy names that you can specify.
newUpdateLoadBalancerAttribute ::
  -- | 'loadBalancerName'
  Prelude.Text ->
  -- | 'attributeName'
  LoadBalancerAttributeName ->
  -- | 'attributeValue'
  Prelude.Text ->
  UpdateLoadBalancerAttribute
newUpdateLoadBalancerAttribute :: Text
-> LoadBalancerAttributeName -> Text -> UpdateLoadBalancerAttribute
newUpdateLoadBalancerAttribute
  Text
pLoadBalancerName_
  LoadBalancerAttributeName
pAttributeName_
  Text
pAttributeValue_ =
    UpdateLoadBalancerAttribute'
      { $sel:loadBalancerName:UpdateLoadBalancerAttribute' :: Text
loadBalancerName =
          Text
pLoadBalancerName_,
        $sel:attributeName:UpdateLoadBalancerAttribute' :: LoadBalancerAttributeName
attributeName = LoadBalancerAttributeName
pAttributeName_,
        $sel:attributeValue:UpdateLoadBalancerAttribute' :: Text
attributeValue = Text
pAttributeValue_
      }

-- | The name of the load balancer that you want to modify (e.g.,
-- @my-load-balancer@.
updateLoadBalancerAttribute_loadBalancerName :: Lens.Lens' UpdateLoadBalancerAttribute Prelude.Text
updateLoadBalancerAttribute_loadBalancerName :: Lens' UpdateLoadBalancerAttribute Text
updateLoadBalancerAttribute_loadBalancerName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateLoadBalancerAttribute' {Text
loadBalancerName :: Text
$sel:loadBalancerName:UpdateLoadBalancerAttribute' :: UpdateLoadBalancerAttribute -> Text
loadBalancerName} -> Text
loadBalancerName) (\s :: UpdateLoadBalancerAttribute
s@UpdateLoadBalancerAttribute' {} Text
a -> UpdateLoadBalancerAttribute
s {$sel:loadBalancerName:UpdateLoadBalancerAttribute' :: Text
loadBalancerName = Text
a} :: UpdateLoadBalancerAttribute)

-- | The name of the attribute you want to update.
updateLoadBalancerAttribute_attributeName :: Lens.Lens' UpdateLoadBalancerAttribute LoadBalancerAttributeName
updateLoadBalancerAttribute_attributeName :: Lens' UpdateLoadBalancerAttribute LoadBalancerAttributeName
updateLoadBalancerAttribute_attributeName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateLoadBalancerAttribute' {LoadBalancerAttributeName
attributeName :: LoadBalancerAttributeName
$sel:attributeName:UpdateLoadBalancerAttribute' :: UpdateLoadBalancerAttribute -> LoadBalancerAttributeName
attributeName} -> LoadBalancerAttributeName
attributeName) (\s :: UpdateLoadBalancerAttribute
s@UpdateLoadBalancerAttribute' {} LoadBalancerAttributeName
a -> UpdateLoadBalancerAttribute
s {$sel:attributeName:UpdateLoadBalancerAttribute' :: LoadBalancerAttributeName
attributeName = LoadBalancerAttributeName
a} :: UpdateLoadBalancerAttribute)

-- | The value that you want to specify for the attribute name.
--
-- The following values are supported depending on what you specify for the
-- @attributeName@ request parameter:
--
-- -   If you specify @HealthCheckPath@ for the @attributeName@ request
--     parameter, then the @attributeValue@ request parameter must be the
--     path to ping on the target (for example,
--     @\/weather\/us\/wa\/seattle@).
--
-- -   If you specify @SessionStickinessEnabled@ for the @attributeName@
--     request parameter, then the @attributeValue@ request parameter must
--     be @true@ to activate session stickiness or @false@ to deactivate
--     session stickiness.
--
-- -   If you specify @SessionStickiness_LB_CookieDurationSeconds@ for the
--     @attributeName@ request parameter, then the @attributeValue@ request
--     parameter must be an interger that represents the cookie duration in
--     seconds.
--
-- -   If you specify @HttpsRedirectionEnabled@ for the @attributeName@
--     request parameter, then the @attributeValue@ request parameter must
--     be @true@ to activate HTTP to HTTPS redirection or @false@ to
--     deactivate HTTP to HTTPS redirection.
--
-- -   If you specify @TlsPolicyName@ for the @attributeName@ request
--     parameter, then the @attributeValue@ request parameter must be the
--     name of the TLS policy.
--
--     Use the
--     <https://docs.aws.amazon.com/lightsail/2016-11-28/api-reference/API_GetLoadBalancerTlsPolicies.html GetLoadBalancerTlsPolicies>
--     action to get a list of TLS policy names that you can specify.
updateLoadBalancerAttribute_attributeValue :: Lens.Lens' UpdateLoadBalancerAttribute Prelude.Text
updateLoadBalancerAttribute_attributeValue :: Lens' UpdateLoadBalancerAttribute Text
updateLoadBalancerAttribute_attributeValue = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateLoadBalancerAttribute' {Text
attributeValue :: Text
$sel:attributeValue:UpdateLoadBalancerAttribute' :: UpdateLoadBalancerAttribute -> Text
attributeValue} -> Text
attributeValue) (\s :: UpdateLoadBalancerAttribute
s@UpdateLoadBalancerAttribute' {} Text
a -> UpdateLoadBalancerAttribute
s {$sel:attributeValue:UpdateLoadBalancerAttribute' :: Text
attributeValue = Text
a} :: UpdateLoadBalancerAttribute)

instance Core.AWSRequest UpdateLoadBalancerAttribute where
  type
    AWSResponse UpdateLoadBalancerAttribute =
      UpdateLoadBalancerAttributeResponse
  request :: (Service -> Service)
-> UpdateLoadBalancerAttribute
-> Request UpdateLoadBalancerAttribute
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 UpdateLoadBalancerAttribute
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse UpdateLoadBalancerAttribute)))
response =
    forall (m :: * -> *) a.
MonadResource m =>
(Int -> ResponseHeaders -> Object -> Either String (AWSResponse a))
-> (ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy a
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse a)))
Response.receiveJSON
      ( \Int
s ResponseHeaders
h Object
x ->
          Maybe [Operation] -> Int -> UpdateLoadBalancerAttributeResponse
UpdateLoadBalancerAttributeResponse'
            forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"operations" forall (f :: * -> *) a. Functor f => f (Maybe a) -> a -> f a
Core..!@ forall a. Monoid a => a
Prelude.mempty)
            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 UpdateLoadBalancerAttribute where
  hashWithSalt :: Int -> UpdateLoadBalancerAttribute -> Int
hashWithSalt Int
_salt UpdateLoadBalancerAttribute' {Text
LoadBalancerAttributeName
attributeValue :: Text
attributeName :: LoadBalancerAttributeName
loadBalancerName :: Text
$sel:attributeValue:UpdateLoadBalancerAttribute' :: UpdateLoadBalancerAttribute -> Text
$sel:attributeName:UpdateLoadBalancerAttribute' :: UpdateLoadBalancerAttribute -> LoadBalancerAttributeName
$sel:loadBalancerName:UpdateLoadBalancerAttribute' :: UpdateLoadBalancerAttribute -> Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
loadBalancerName
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` LoadBalancerAttributeName
attributeName
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
attributeValue

instance Prelude.NFData UpdateLoadBalancerAttribute where
  rnf :: UpdateLoadBalancerAttribute -> ()
rnf UpdateLoadBalancerAttribute' {Text
LoadBalancerAttributeName
attributeValue :: Text
attributeName :: LoadBalancerAttributeName
loadBalancerName :: Text
$sel:attributeValue:UpdateLoadBalancerAttribute' :: UpdateLoadBalancerAttribute -> Text
$sel:attributeName:UpdateLoadBalancerAttribute' :: UpdateLoadBalancerAttribute -> LoadBalancerAttributeName
$sel:loadBalancerName:UpdateLoadBalancerAttribute' :: UpdateLoadBalancerAttribute -> Text
..} =
    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 LoadBalancerAttributeName
attributeName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
attributeValue

instance Data.ToHeaders UpdateLoadBalancerAttribute where
  toHeaders :: UpdateLoadBalancerAttribute -> ResponseHeaders
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 -> ResponseHeaders
Data.=# ( ByteString
"Lightsail_20161128.UpdateLoadBalancerAttribute" ::
                          Prelude.ByteString
                      ),
            HeaderName
"Content-Type"
              forall a. ToHeader a => HeaderName -> a -> ResponseHeaders
Data.=# ( ByteString
"application/x-amz-json-1.1" ::
                          Prelude.ByteString
                      )
          ]
      )

instance Data.ToJSON UpdateLoadBalancerAttribute where
  toJSON :: UpdateLoadBalancerAttribute -> Value
toJSON UpdateLoadBalancerAttribute' {Text
LoadBalancerAttributeName
attributeValue :: Text
attributeName :: LoadBalancerAttributeName
loadBalancerName :: Text
$sel:attributeValue:UpdateLoadBalancerAttribute' :: UpdateLoadBalancerAttribute -> Text
$sel:attributeName:UpdateLoadBalancerAttribute' :: UpdateLoadBalancerAttribute -> LoadBalancerAttributeName
$sel:loadBalancerName:UpdateLoadBalancerAttribute' :: UpdateLoadBalancerAttribute -> Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ forall a. a -> Maybe a
Prelude.Just
              (Key
"loadBalancerName" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
loadBalancerName),
            forall a. a -> Maybe a
Prelude.Just (Key
"attributeName" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= LoadBalancerAttributeName
attributeName),
            forall a. a -> Maybe a
Prelude.Just
              (Key
"attributeValue" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
attributeValue)
          ]
      )

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

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

-- | /See:/ 'newUpdateLoadBalancerAttributeResponse' smart constructor.
data UpdateLoadBalancerAttributeResponse = UpdateLoadBalancerAttributeResponse'
  { -- | An array of objects that describe the result of the action, such as the
    -- status of the request, the timestamp of the request, and the resources
    -- affected by the request.
    UpdateLoadBalancerAttributeResponse -> Maybe [Operation]
operations :: Prelude.Maybe [Operation],
    -- | The response's http status code.
    UpdateLoadBalancerAttributeResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (UpdateLoadBalancerAttributeResponse
-> UpdateLoadBalancerAttributeResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UpdateLoadBalancerAttributeResponse
-> UpdateLoadBalancerAttributeResponse -> Bool
$c/= :: UpdateLoadBalancerAttributeResponse
-> UpdateLoadBalancerAttributeResponse -> Bool
== :: UpdateLoadBalancerAttributeResponse
-> UpdateLoadBalancerAttributeResponse -> Bool
$c== :: UpdateLoadBalancerAttributeResponse
-> UpdateLoadBalancerAttributeResponse -> Bool
Prelude.Eq, ReadPrec [UpdateLoadBalancerAttributeResponse]
ReadPrec UpdateLoadBalancerAttributeResponse
Int -> ReadS UpdateLoadBalancerAttributeResponse
ReadS [UpdateLoadBalancerAttributeResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [UpdateLoadBalancerAttributeResponse]
$creadListPrec :: ReadPrec [UpdateLoadBalancerAttributeResponse]
readPrec :: ReadPrec UpdateLoadBalancerAttributeResponse
$creadPrec :: ReadPrec UpdateLoadBalancerAttributeResponse
readList :: ReadS [UpdateLoadBalancerAttributeResponse]
$creadList :: ReadS [UpdateLoadBalancerAttributeResponse]
readsPrec :: Int -> ReadS UpdateLoadBalancerAttributeResponse
$creadsPrec :: Int -> ReadS UpdateLoadBalancerAttributeResponse
Prelude.Read, Int -> UpdateLoadBalancerAttributeResponse -> ShowS
[UpdateLoadBalancerAttributeResponse] -> ShowS
UpdateLoadBalancerAttributeResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UpdateLoadBalancerAttributeResponse] -> ShowS
$cshowList :: [UpdateLoadBalancerAttributeResponse] -> ShowS
show :: UpdateLoadBalancerAttributeResponse -> String
$cshow :: UpdateLoadBalancerAttributeResponse -> String
showsPrec :: Int -> UpdateLoadBalancerAttributeResponse -> ShowS
$cshowsPrec :: Int -> UpdateLoadBalancerAttributeResponse -> ShowS
Prelude.Show, forall x.
Rep UpdateLoadBalancerAttributeResponse x
-> UpdateLoadBalancerAttributeResponse
forall x.
UpdateLoadBalancerAttributeResponse
-> Rep UpdateLoadBalancerAttributeResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep UpdateLoadBalancerAttributeResponse x
-> UpdateLoadBalancerAttributeResponse
$cfrom :: forall x.
UpdateLoadBalancerAttributeResponse
-> Rep UpdateLoadBalancerAttributeResponse x
Prelude.Generic)

-- |
-- Create a value of 'UpdateLoadBalancerAttributeResponse' 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:
--
-- 'operations', 'updateLoadBalancerAttributeResponse_operations' - An array of objects that describe the result of the action, such as the
-- status of the request, the timestamp of the request, and the resources
-- affected by the request.
--
-- 'httpStatus', 'updateLoadBalancerAttributeResponse_httpStatus' - The response's http status code.
newUpdateLoadBalancerAttributeResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  UpdateLoadBalancerAttributeResponse
newUpdateLoadBalancerAttributeResponse :: Int -> UpdateLoadBalancerAttributeResponse
newUpdateLoadBalancerAttributeResponse Int
pHttpStatus_ =
  UpdateLoadBalancerAttributeResponse'
    { $sel:operations:UpdateLoadBalancerAttributeResponse' :: Maybe [Operation]
operations =
        forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:UpdateLoadBalancerAttributeResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | An array of objects that describe the result of the action, such as the
-- status of the request, the timestamp of the request, and the resources
-- affected by the request.
updateLoadBalancerAttributeResponse_operations :: Lens.Lens' UpdateLoadBalancerAttributeResponse (Prelude.Maybe [Operation])
updateLoadBalancerAttributeResponse_operations :: Lens' UpdateLoadBalancerAttributeResponse (Maybe [Operation])
updateLoadBalancerAttributeResponse_operations = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateLoadBalancerAttributeResponse' {Maybe [Operation]
operations :: Maybe [Operation]
$sel:operations:UpdateLoadBalancerAttributeResponse' :: UpdateLoadBalancerAttributeResponse -> Maybe [Operation]
operations} -> Maybe [Operation]
operations) (\s :: UpdateLoadBalancerAttributeResponse
s@UpdateLoadBalancerAttributeResponse' {} Maybe [Operation]
a -> UpdateLoadBalancerAttributeResponse
s {$sel:operations:UpdateLoadBalancerAttributeResponse' :: Maybe [Operation]
operations = Maybe [Operation]
a} :: UpdateLoadBalancerAttributeResponse) 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.
updateLoadBalancerAttributeResponse_httpStatus :: Lens.Lens' UpdateLoadBalancerAttributeResponse Prelude.Int
updateLoadBalancerAttributeResponse_httpStatus :: Lens' UpdateLoadBalancerAttributeResponse Int
updateLoadBalancerAttributeResponse_httpStatus = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateLoadBalancerAttributeResponse' {Int
httpStatus :: Int
$sel:httpStatus:UpdateLoadBalancerAttributeResponse' :: UpdateLoadBalancerAttributeResponse -> Int
httpStatus} -> Int
httpStatus) (\s :: UpdateLoadBalancerAttributeResponse
s@UpdateLoadBalancerAttributeResponse' {} Int
a -> UpdateLoadBalancerAttributeResponse
s {$sel:httpStatus:UpdateLoadBalancerAttributeResponse' :: Int
httpStatus = Int
a} :: UpdateLoadBalancerAttributeResponse)

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