{-# 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.GlobalAccelerator.UpdateListener
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Update a listener.
module Amazonka.GlobalAccelerator.UpdateListener
  ( -- * Creating a Request
    UpdateListener (..),
    newUpdateListener,

    -- * Request Lenses
    updateListener_clientAffinity,
    updateListener_portRanges,
    updateListener_protocol,
    updateListener_listenerArn,

    -- * Destructuring the Response
    UpdateListenerResponse (..),
    newUpdateListenerResponse,

    -- * Response Lenses
    updateListenerResponse_listener,
    updateListenerResponse_httpStatus,
  )
where

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

-- | /See:/ 'newUpdateListener' smart constructor.
data UpdateListener = UpdateListener'
  { -- | Client affinity lets you direct all requests from a user to the same
    -- endpoint, if you have stateful applications, regardless of the port and
    -- protocol of the client request. Client affinity gives you control over
    -- whether to always route each client to the same specific endpoint.
    --
    -- Global Accelerator uses a consistent-flow hashing algorithm to choose
    -- the optimal endpoint for a connection. If client affinity is @NONE@,
    -- Global Accelerator uses the \"five-tuple\" (5-tuple) properties—source
    -- IP address, source port, destination IP address, destination port, and
    -- protocol—to select the hash value, and then chooses the best endpoint.
    -- However, with this setting, if someone uses different ports to connect
    -- to Global Accelerator, their connections might not be always routed to
    -- the same endpoint because the hash value changes.
    --
    -- If you want a given client to always be routed to the same endpoint, set
    -- client affinity to @SOURCE_IP@ instead. When you use the @SOURCE_IP@
    -- setting, Global Accelerator uses the \"two-tuple\" (2-tuple) properties—
    -- source (client) IP address and destination IP address—to select the hash
    -- value.
    --
    -- The default value is @NONE@.
    UpdateListener -> Maybe ClientAffinity
clientAffinity :: Prelude.Maybe ClientAffinity,
    -- | The updated list of port ranges for the connections from clients to the
    -- accelerator.
    UpdateListener -> Maybe (NonEmpty PortRange)
portRanges :: Prelude.Maybe (Prelude.NonEmpty PortRange),
    -- | The updated protocol for the connections from clients to the
    -- accelerator.
    UpdateListener -> Maybe Protocol
protocol :: Prelude.Maybe Protocol,
    -- | The Amazon Resource Name (ARN) of the listener to update.
    UpdateListener -> Text
listenerArn :: Prelude.Text
  }
  deriving (UpdateListener -> UpdateListener -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UpdateListener -> UpdateListener -> Bool
$c/= :: UpdateListener -> UpdateListener -> Bool
== :: UpdateListener -> UpdateListener -> Bool
$c== :: UpdateListener -> UpdateListener -> Bool
Prelude.Eq, ReadPrec [UpdateListener]
ReadPrec UpdateListener
Int -> ReadS UpdateListener
ReadS [UpdateListener]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [UpdateListener]
$creadListPrec :: ReadPrec [UpdateListener]
readPrec :: ReadPrec UpdateListener
$creadPrec :: ReadPrec UpdateListener
readList :: ReadS [UpdateListener]
$creadList :: ReadS [UpdateListener]
readsPrec :: Int -> ReadS UpdateListener
$creadsPrec :: Int -> ReadS UpdateListener
Prelude.Read, Int -> UpdateListener -> ShowS
[UpdateListener] -> ShowS
UpdateListener -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UpdateListener] -> ShowS
$cshowList :: [UpdateListener] -> ShowS
show :: UpdateListener -> String
$cshow :: UpdateListener -> String
showsPrec :: Int -> UpdateListener -> ShowS
$cshowsPrec :: Int -> UpdateListener -> ShowS
Prelude.Show, forall x. Rep UpdateListener x -> UpdateListener
forall x. UpdateListener -> Rep UpdateListener x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep UpdateListener x -> UpdateListener
$cfrom :: forall x. UpdateListener -> Rep UpdateListener x
Prelude.Generic)

-- |
-- Create a value of 'UpdateListener' 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:
--
-- 'clientAffinity', 'updateListener_clientAffinity' - Client affinity lets you direct all requests from a user to the same
-- endpoint, if you have stateful applications, regardless of the port and
-- protocol of the client request. Client affinity gives you control over
-- whether to always route each client to the same specific endpoint.
--
-- Global Accelerator uses a consistent-flow hashing algorithm to choose
-- the optimal endpoint for a connection. If client affinity is @NONE@,
-- Global Accelerator uses the \"five-tuple\" (5-tuple) properties—source
-- IP address, source port, destination IP address, destination port, and
-- protocol—to select the hash value, and then chooses the best endpoint.
-- However, with this setting, if someone uses different ports to connect
-- to Global Accelerator, their connections might not be always routed to
-- the same endpoint because the hash value changes.
--
-- If you want a given client to always be routed to the same endpoint, set
-- client affinity to @SOURCE_IP@ instead. When you use the @SOURCE_IP@
-- setting, Global Accelerator uses the \"two-tuple\" (2-tuple) properties—
-- source (client) IP address and destination IP address—to select the hash
-- value.
--
-- The default value is @NONE@.
--
-- 'portRanges', 'updateListener_portRanges' - The updated list of port ranges for the connections from clients to the
-- accelerator.
--
-- 'protocol', 'updateListener_protocol' - The updated protocol for the connections from clients to the
-- accelerator.
--
-- 'listenerArn', 'updateListener_listenerArn' - The Amazon Resource Name (ARN) of the listener to update.
newUpdateListener ::
  -- | 'listenerArn'
  Prelude.Text ->
  UpdateListener
newUpdateListener :: Text -> UpdateListener
newUpdateListener Text
pListenerArn_ =
  UpdateListener'
    { $sel:clientAffinity:UpdateListener' :: Maybe ClientAffinity
clientAffinity = forall a. Maybe a
Prelude.Nothing,
      $sel:portRanges:UpdateListener' :: Maybe (NonEmpty PortRange)
portRanges = forall a. Maybe a
Prelude.Nothing,
      $sel:protocol:UpdateListener' :: Maybe Protocol
protocol = forall a. Maybe a
Prelude.Nothing,
      $sel:listenerArn:UpdateListener' :: Text
listenerArn = Text
pListenerArn_
    }

-- | Client affinity lets you direct all requests from a user to the same
-- endpoint, if you have stateful applications, regardless of the port and
-- protocol of the client request. Client affinity gives you control over
-- whether to always route each client to the same specific endpoint.
--
-- Global Accelerator uses a consistent-flow hashing algorithm to choose
-- the optimal endpoint for a connection. If client affinity is @NONE@,
-- Global Accelerator uses the \"five-tuple\" (5-tuple) properties—source
-- IP address, source port, destination IP address, destination port, and
-- protocol—to select the hash value, and then chooses the best endpoint.
-- However, with this setting, if someone uses different ports to connect
-- to Global Accelerator, their connections might not be always routed to
-- the same endpoint because the hash value changes.
--
-- If you want a given client to always be routed to the same endpoint, set
-- client affinity to @SOURCE_IP@ instead. When you use the @SOURCE_IP@
-- setting, Global Accelerator uses the \"two-tuple\" (2-tuple) properties—
-- source (client) IP address and destination IP address—to select the hash
-- value.
--
-- The default value is @NONE@.
updateListener_clientAffinity :: Lens.Lens' UpdateListener (Prelude.Maybe ClientAffinity)
updateListener_clientAffinity :: Lens' UpdateListener (Maybe ClientAffinity)
updateListener_clientAffinity = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateListener' {Maybe ClientAffinity
clientAffinity :: Maybe ClientAffinity
$sel:clientAffinity:UpdateListener' :: UpdateListener -> Maybe ClientAffinity
clientAffinity} -> Maybe ClientAffinity
clientAffinity) (\s :: UpdateListener
s@UpdateListener' {} Maybe ClientAffinity
a -> UpdateListener
s {$sel:clientAffinity:UpdateListener' :: Maybe ClientAffinity
clientAffinity = Maybe ClientAffinity
a} :: UpdateListener)

-- | The updated list of port ranges for the connections from clients to the
-- accelerator.
updateListener_portRanges :: Lens.Lens' UpdateListener (Prelude.Maybe (Prelude.NonEmpty PortRange))
updateListener_portRanges :: Lens' UpdateListener (Maybe (NonEmpty PortRange))
updateListener_portRanges = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateListener' {Maybe (NonEmpty PortRange)
portRanges :: Maybe (NonEmpty PortRange)
$sel:portRanges:UpdateListener' :: UpdateListener -> Maybe (NonEmpty PortRange)
portRanges} -> Maybe (NonEmpty PortRange)
portRanges) (\s :: UpdateListener
s@UpdateListener' {} Maybe (NonEmpty PortRange)
a -> UpdateListener
s {$sel:portRanges:UpdateListener' :: Maybe (NonEmpty PortRange)
portRanges = Maybe (NonEmpty PortRange)
a} :: UpdateListener) 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 updated protocol for the connections from clients to the
-- accelerator.
updateListener_protocol :: Lens.Lens' UpdateListener (Prelude.Maybe Protocol)
updateListener_protocol :: Lens' UpdateListener (Maybe Protocol)
updateListener_protocol = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateListener' {Maybe Protocol
protocol :: Maybe Protocol
$sel:protocol:UpdateListener' :: UpdateListener -> Maybe Protocol
protocol} -> Maybe Protocol
protocol) (\s :: UpdateListener
s@UpdateListener' {} Maybe Protocol
a -> UpdateListener
s {$sel:protocol:UpdateListener' :: Maybe Protocol
protocol = Maybe Protocol
a} :: UpdateListener)

-- | The Amazon Resource Name (ARN) of the listener to update.
updateListener_listenerArn :: Lens.Lens' UpdateListener Prelude.Text
updateListener_listenerArn :: Lens' UpdateListener Text
updateListener_listenerArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateListener' {Text
listenerArn :: Text
$sel:listenerArn:UpdateListener' :: UpdateListener -> Text
listenerArn} -> Text
listenerArn) (\s :: UpdateListener
s@UpdateListener' {} Text
a -> UpdateListener
s {$sel:listenerArn:UpdateListener' :: Text
listenerArn = Text
a} :: UpdateListener)

instance Core.AWSRequest UpdateListener where
  type
    AWSResponse UpdateListener =
      UpdateListenerResponse
  request :: (Service -> Service) -> UpdateListener -> Request UpdateListener
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 UpdateListener
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse UpdateListener)))
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 Listener -> Int -> UpdateListenerResponse
UpdateListenerResponse'
            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
"Listener")
            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 UpdateListener where
  hashWithSalt :: Int -> UpdateListener -> Int
hashWithSalt Int
_salt UpdateListener' {Maybe (NonEmpty PortRange)
Maybe ClientAffinity
Maybe Protocol
Text
listenerArn :: Text
protocol :: Maybe Protocol
portRanges :: Maybe (NonEmpty PortRange)
clientAffinity :: Maybe ClientAffinity
$sel:listenerArn:UpdateListener' :: UpdateListener -> Text
$sel:protocol:UpdateListener' :: UpdateListener -> Maybe Protocol
$sel:portRanges:UpdateListener' :: UpdateListener -> Maybe (NonEmpty PortRange)
$sel:clientAffinity:UpdateListener' :: UpdateListener -> Maybe ClientAffinity
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe ClientAffinity
clientAffinity
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe (NonEmpty PortRange)
portRanges
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Protocol
protocol
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
listenerArn

instance Prelude.NFData UpdateListener where
  rnf :: UpdateListener -> ()
rnf UpdateListener' {Maybe (NonEmpty PortRange)
Maybe ClientAffinity
Maybe Protocol
Text
listenerArn :: Text
protocol :: Maybe Protocol
portRanges :: Maybe (NonEmpty PortRange)
clientAffinity :: Maybe ClientAffinity
$sel:listenerArn:UpdateListener' :: UpdateListener -> Text
$sel:protocol:UpdateListener' :: UpdateListener -> Maybe Protocol
$sel:portRanges:UpdateListener' :: UpdateListener -> Maybe (NonEmpty PortRange)
$sel:clientAffinity:UpdateListener' :: UpdateListener -> Maybe ClientAffinity
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe ClientAffinity
clientAffinity
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe (NonEmpty PortRange)
portRanges
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Protocol
protocol
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
listenerArn

instance Data.ToHeaders UpdateListener where
  toHeaders :: UpdateListener -> 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
"GlobalAccelerator_V20180706.UpdateListener" ::
                          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 UpdateListener where
  toJSON :: UpdateListener -> Value
toJSON UpdateListener' {Maybe (NonEmpty PortRange)
Maybe ClientAffinity
Maybe Protocol
Text
listenerArn :: Text
protocol :: Maybe Protocol
portRanges :: Maybe (NonEmpty PortRange)
clientAffinity :: Maybe ClientAffinity
$sel:listenerArn:UpdateListener' :: UpdateListener -> Text
$sel:protocol:UpdateListener' :: UpdateListener -> Maybe Protocol
$sel:portRanges:UpdateListener' :: UpdateListener -> Maybe (NonEmpty PortRange)
$sel:clientAffinity:UpdateListener' :: UpdateListener -> Maybe ClientAffinity
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"ClientAffinity" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=)
              forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe ClientAffinity
clientAffinity,
            (Key
"PortRanges" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe (NonEmpty PortRange)
portRanges,
            (Key
"Protocol" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe Protocol
protocol,
            forall a. a -> Maybe a
Prelude.Just (Key
"ListenerArn" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
listenerArn)
          ]
      )

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

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

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

-- |
-- Create a value of 'UpdateListenerResponse' 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:
--
-- 'listener', 'updateListenerResponse_listener' - Information for the updated listener.
--
-- 'httpStatus', 'updateListenerResponse_httpStatus' - The response's http status code.
newUpdateListenerResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  UpdateListenerResponse
newUpdateListenerResponse :: Int -> UpdateListenerResponse
newUpdateListenerResponse Int
pHttpStatus_ =
  UpdateListenerResponse'
    { $sel:listener:UpdateListenerResponse' :: Maybe Listener
listener = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:UpdateListenerResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | Information for the updated listener.
updateListenerResponse_listener :: Lens.Lens' UpdateListenerResponse (Prelude.Maybe Listener)
updateListenerResponse_listener :: Lens' UpdateListenerResponse (Maybe Listener)
updateListenerResponse_listener = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateListenerResponse' {Maybe Listener
listener :: Maybe Listener
$sel:listener:UpdateListenerResponse' :: UpdateListenerResponse -> Maybe Listener
listener} -> Maybe Listener
listener) (\s :: UpdateListenerResponse
s@UpdateListenerResponse' {} Maybe Listener
a -> UpdateListenerResponse
s {$sel:listener:UpdateListenerResponse' :: Maybe Listener
listener = Maybe Listener
a} :: UpdateListenerResponse)

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

instance Prelude.NFData UpdateListenerResponse where
  rnf :: UpdateListenerResponse -> ()
rnf UpdateListenerResponse' {Int
Maybe Listener
httpStatus :: Int
listener :: Maybe Listener
$sel:httpStatus:UpdateListenerResponse' :: UpdateListenerResponse -> Int
$sel:listener:UpdateListenerResponse' :: UpdateListenerResponse -> Maybe Listener
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Listener
listener
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus