{-# 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.CreateListener
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Create a listener to process inbound connections from clients to an
-- accelerator. Connections arrive to assigned static IP addresses on a
-- port, port range, or list of port ranges that you specify.
module Amazonka.GlobalAccelerator.CreateListener
  ( -- * Creating a Request
    CreateListener (..),
    newCreateListener,

    -- * Request Lenses
    createListener_clientAffinity,
    createListener_acceleratorArn,
    createListener_portRanges,
    createListener_protocol,
    createListener_idempotencyToken,

    -- * Destructuring the Response
    CreateListenerResponse (..),
    newCreateListenerResponse,

    -- * Response Lenses
    createListenerResponse_listener,
    createListenerResponse_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:/ 'newCreateListener' smart constructor.
data CreateListener = CreateListener'
  { -- | 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@.
    CreateListener -> Maybe ClientAffinity
clientAffinity :: Prelude.Maybe ClientAffinity,
    -- | The Amazon Resource Name (ARN) of your accelerator.
    CreateListener -> Text
acceleratorArn :: Prelude.Text,
    -- | The list of port ranges to support for connections from clients to your
    -- accelerator.
    CreateListener -> NonEmpty PortRange
portRanges :: Prelude.NonEmpty PortRange,
    -- | The protocol for connections from clients to your accelerator.
    CreateListener -> Protocol
protocol :: Protocol,
    -- | A unique, case-sensitive identifier that you provide to ensure the
    -- idempotency—that is, the uniqueness—of the request.
    CreateListener -> Text
idempotencyToken :: Prelude.Text
  }
  deriving (CreateListener -> CreateListener -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateListener -> CreateListener -> Bool
$c/= :: CreateListener -> CreateListener -> Bool
== :: CreateListener -> CreateListener -> Bool
$c== :: CreateListener -> CreateListener -> Bool
Prelude.Eq, ReadPrec [CreateListener]
ReadPrec CreateListener
Int -> ReadS CreateListener
ReadS [CreateListener]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CreateListener]
$creadListPrec :: ReadPrec [CreateListener]
readPrec :: ReadPrec CreateListener
$creadPrec :: ReadPrec CreateListener
readList :: ReadS [CreateListener]
$creadList :: ReadS [CreateListener]
readsPrec :: Int -> ReadS CreateListener
$creadsPrec :: Int -> ReadS CreateListener
Prelude.Read, Int -> CreateListener -> ShowS
[CreateListener] -> ShowS
CreateListener -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateListener] -> ShowS
$cshowList :: [CreateListener] -> ShowS
show :: CreateListener -> String
$cshow :: CreateListener -> String
showsPrec :: Int -> CreateListener -> ShowS
$cshowsPrec :: Int -> CreateListener -> ShowS
Prelude.Show, forall x. Rep CreateListener x -> CreateListener
forall x. CreateListener -> Rep CreateListener x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CreateListener x -> CreateListener
$cfrom :: forall x. CreateListener -> Rep CreateListener x
Prelude.Generic)

-- |
-- Create a value of 'CreateListener' 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', 'createListener_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@.
--
-- 'acceleratorArn', 'createListener_acceleratorArn' - The Amazon Resource Name (ARN) of your accelerator.
--
-- 'portRanges', 'createListener_portRanges' - The list of port ranges to support for connections from clients to your
-- accelerator.
--
-- 'protocol', 'createListener_protocol' - The protocol for connections from clients to your accelerator.
--
-- 'idempotencyToken', 'createListener_idempotencyToken' - A unique, case-sensitive identifier that you provide to ensure the
-- idempotency—that is, the uniqueness—of the request.
newCreateListener ::
  -- | 'acceleratorArn'
  Prelude.Text ->
  -- | 'portRanges'
  Prelude.NonEmpty PortRange ->
  -- | 'protocol'
  Protocol ->
  -- | 'idempotencyToken'
  Prelude.Text ->
  CreateListener
newCreateListener :: Text -> NonEmpty PortRange -> Protocol -> Text -> CreateListener
newCreateListener
  Text
pAcceleratorArn_
  NonEmpty PortRange
pPortRanges_
  Protocol
pProtocol_
  Text
pIdempotencyToken_ =
    CreateListener'
      { $sel:clientAffinity:CreateListener' :: Maybe ClientAffinity
clientAffinity = forall a. Maybe a
Prelude.Nothing,
        $sel:acceleratorArn:CreateListener' :: Text
acceleratorArn = Text
pAcceleratorArn_,
        $sel:portRanges:CreateListener' :: NonEmpty PortRange
portRanges = forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Lens.coerced forall t b. AReview t b -> b -> t
Lens.# NonEmpty PortRange
pPortRanges_,
        $sel:protocol:CreateListener' :: Protocol
protocol = Protocol
pProtocol_,
        $sel:idempotencyToken:CreateListener' :: Text
idempotencyToken = Text
pIdempotencyToken_
      }

-- | 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@.
createListener_clientAffinity :: Lens.Lens' CreateListener (Prelude.Maybe ClientAffinity)
createListener_clientAffinity :: Lens' CreateListener (Maybe ClientAffinity)
createListener_clientAffinity = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateListener' {Maybe ClientAffinity
clientAffinity :: Maybe ClientAffinity
$sel:clientAffinity:CreateListener' :: CreateListener -> Maybe ClientAffinity
clientAffinity} -> Maybe ClientAffinity
clientAffinity) (\s :: CreateListener
s@CreateListener' {} Maybe ClientAffinity
a -> CreateListener
s {$sel:clientAffinity:CreateListener' :: Maybe ClientAffinity
clientAffinity = Maybe ClientAffinity
a} :: CreateListener)

-- | The Amazon Resource Name (ARN) of your accelerator.
createListener_acceleratorArn :: Lens.Lens' CreateListener Prelude.Text
createListener_acceleratorArn :: Lens' CreateListener Text
createListener_acceleratorArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateListener' {Text
acceleratorArn :: Text
$sel:acceleratorArn:CreateListener' :: CreateListener -> Text
acceleratorArn} -> Text
acceleratorArn) (\s :: CreateListener
s@CreateListener' {} Text
a -> CreateListener
s {$sel:acceleratorArn:CreateListener' :: Text
acceleratorArn = Text
a} :: CreateListener)

-- | The list of port ranges to support for connections from clients to your
-- accelerator.
createListener_portRanges :: Lens.Lens' CreateListener (Prelude.NonEmpty PortRange)
createListener_portRanges :: Lens' CreateListener (NonEmpty PortRange)
createListener_portRanges = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateListener' {NonEmpty PortRange
portRanges :: NonEmpty PortRange
$sel:portRanges:CreateListener' :: CreateListener -> NonEmpty PortRange
portRanges} -> NonEmpty PortRange
portRanges) (\s :: CreateListener
s@CreateListener' {} NonEmpty PortRange
a -> CreateListener
s {$sel:portRanges:CreateListener' :: NonEmpty PortRange
portRanges = NonEmpty PortRange
a} :: CreateListener) 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

-- | The protocol for connections from clients to your accelerator.
createListener_protocol :: Lens.Lens' CreateListener Protocol
createListener_protocol :: Lens' CreateListener Protocol
createListener_protocol = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateListener' {Protocol
protocol :: Protocol
$sel:protocol:CreateListener' :: CreateListener -> Protocol
protocol} -> Protocol
protocol) (\s :: CreateListener
s@CreateListener' {} Protocol
a -> CreateListener
s {$sel:protocol:CreateListener' :: Protocol
protocol = Protocol
a} :: CreateListener)

-- | A unique, case-sensitive identifier that you provide to ensure the
-- idempotency—that is, the uniqueness—of the request.
createListener_idempotencyToken :: Lens.Lens' CreateListener Prelude.Text
createListener_idempotencyToken :: Lens' CreateListener Text
createListener_idempotencyToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateListener' {Text
idempotencyToken :: Text
$sel:idempotencyToken:CreateListener' :: CreateListener -> Text
idempotencyToken} -> Text
idempotencyToken) (\s :: CreateListener
s@CreateListener' {} Text
a -> CreateListener
s {$sel:idempotencyToken:CreateListener' :: Text
idempotencyToken = Text
a} :: CreateListener)

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

instance Prelude.NFData CreateListener where
  rnf :: CreateListener -> ()
rnf CreateListener' {Maybe ClientAffinity
NonEmpty PortRange
Text
Protocol
idempotencyToken :: Text
protocol :: Protocol
portRanges :: NonEmpty PortRange
acceleratorArn :: Text
clientAffinity :: Maybe ClientAffinity
$sel:idempotencyToken:CreateListener' :: CreateListener -> Text
$sel:protocol:CreateListener' :: CreateListener -> Protocol
$sel:portRanges:CreateListener' :: CreateListener -> NonEmpty PortRange
$sel:acceleratorArn:CreateListener' :: CreateListener -> Text
$sel:clientAffinity:CreateListener' :: CreateListener -> 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 Text
acceleratorArn
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf NonEmpty PortRange
portRanges
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Protocol
protocol
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
idempotencyToken

instance Data.ToHeaders CreateListener where
  toHeaders :: CreateListener -> 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.CreateListener" ::
                          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 CreateListener where
  toJSON :: CreateListener -> Value
toJSON CreateListener' {Maybe ClientAffinity
NonEmpty PortRange
Text
Protocol
idempotencyToken :: Text
protocol :: Protocol
portRanges :: NonEmpty PortRange
acceleratorArn :: Text
clientAffinity :: Maybe ClientAffinity
$sel:idempotencyToken:CreateListener' :: CreateListener -> Text
$sel:protocol:CreateListener' :: CreateListener -> Protocol
$sel:portRanges:CreateListener' :: CreateListener -> NonEmpty PortRange
$sel:acceleratorArn:CreateListener' :: CreateListener -> Text
$sel:clientAffinity:CreateListener' :: CreateListener -> 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,
            forall a. a -> Maybe a
Prelude.Just
              (Key
"AcceleratorArn" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
acceleratorArn),
            forall a. a -> Maybe a
Prelude.Just (Key
"PortRanges" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= NonEmpty PortRange
portRanges),
            forall a. a -> Maybe a
Prelude.Just (Key
"Protocol" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Protocol
protocol),
            forall a. a -> Maybe a
Prelude.Just
              (Key
"IdempotencyToken" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
idempotencyToken)
          ]
      )

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

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

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

-- |
-- Create a value of 'CreateListenerResponse' 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', 'createListenerResponse_listener' - The listener that you\'ve created.
--
-- 'httpStatus', 'createListenerResponse_httpStatus' - The response's http status code.
newCreateListenerResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  CreateListenerResponse
newCreateListenerResponse :: Int -> CreateListenerResponse
newCreateListenerResponse Int
pHttpStatus_ =
  CreateListenerResponse'
    { $sel:listener:CreateListenerResponse' :: Maybe Listener
listener = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:CreateListenerResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | The listener that you\'ve created.
createListenerResponse_listener :: Lens.Lens' CreateListenerResponse (Prelude.Maybe Listener)
createListenerResponse_listener :: Lens' CreateListenerResponse (Maybe Listener)
createListenerResponse_listener = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateListenerResponse' {Maybe Listener
listener :: Maybe Listener
$sel:listener:CreateListenerResponse' :: CreateListenerResponse -> Maybe Listener
listener} -> Maybe Listener
listener) (\s :: CreateListenerResponse
s@CreateListenerResponse' {} Maybe Listener
a -> CreateListenerResponse
s {$sel:listener:CreateListenerResponse' :: Maybe Listener
listener = Maybe Listener
a} :: CreateListenerResponse)

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

instance Prelude.NFData CreateListenerResponse where
  rnf :: CreateListenerResponse -> ()
rnf CreateListenerResponse' {Int
Maybe Listener
httpStatus :: Int
listener :: Maybe Listener
$sel:httpStatus:CreateListenerResponse' :: CreateListenerResponse -> Int
$sel:listener:CreateListenerResponse' :: CreateListenerResponse -> 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