{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE StrictData #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# 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.Types.Listener
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
module Amazonka.GlobalAccelerator.Types.Listener 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.ClientAffinity
import Amazonka.GlobalAccelerator.Types.PortRange
import Amazonka.GlobalAccelerator.Types.Protocol
import qualified Amazonka.Prelude as Prelude

-- | A complex type for a listener.
--
-- /See:/ 'newListener' smart constructor.
data Listener = Listener'
  { -- | 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@.
    Listener -> Maybe ClientAffinity
clientAffinity :: Prelude.Maybe ClientAffinity,
    -- | The Amazon Resource Name (ARN) of the listener.
    Listener -> Maybe Text
listenerArn :: Prelude.Maybe Prelude.Text,
    -- | The list of port ranges for the connections from clients to the
    -- accelerator.
    Listener -> Maybe (NonEmpty PortRange)
portRanges :: Prelude.Maybe (Prelude.NonEmpty PortRange),
    -- | The protocol for the connections from clients to the accelerator.
    Listener -> Maybe Protocol
protocol :: Prelude.Maybe Protocol
  }
  deriving (Listener -> Listener -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Listener -> Listener -> Bool
$c/= :: Listener -> Listener -> Bool
== :: Listener -> Listener -> Bool
$c== :: Listener -> Listener -> Bool
Prelude.Eq, ReadPrec [Listener]
ReadPrec Listener
Int -> ReadS Listener
ReadS [Listener]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Listener]
$creadListPrec :: ReadPrec [Listener]
readPrec :: ReadPrec Listener
$creadPrec :: ReadPrec Listener
readList :: ReadS [Listener]
$creadList :: ReadS [Listener]
readsPrec :: Int -> ReadS Listener
$creadsPrec :: Int -> ReadS Listener
Prelude.Read, Int -> Listener -> ShowS
[Listener] -> ShowS
Listener -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Listener] -> ShowS
$cshowList :: [Listener] -> ShowS
show :: Listener -> String
$cshow :: Listener -> String
showsPrec :: Int -> Listener -> ShowS
$cshowsPrec :: Int -> Listener -> ShowS
Prelude.Show, forall x. Rep Listener x -> Listener
forall x. Listener -> Rep Listener x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Listener x -> Listener
$cfrom :: forall x. Listener -> Rep Listener x
Prelude.Generic)

-- |
-- Create a value of 'Listener' 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', 'listener_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@.
--
-- 'listenerArn', 'listener_listenerArn' - The Amazon Resource Name (ARN) of the listener.
--
-- 'portRanges', 'listener_portRanges' - The list of port ranges for the connections from clients to the
-- accelerator.
--
-- 'protocol', 'listener_protocol' - The protocol for the connections from clients to the accelerator.
newListener ::
  Listener
newListener :: Listener
newListener =
  Listener'
    { $sel:clientAffinity:Listener' :: Maybe ClientAffinity
clientAffinity = forall a. Maybe a
Prelude.Nothing,
      $sel:listenerArn:Listener' :: Maybe Text
listenerArn = forall a. Maybe a
Prelude.Nothing,
      $sel:portRanges:Listener' :: Maybe (NonEmpty PortRange)
portRanges = forall a. Maybe a
Prelude.Nothing,
      $sel:protocol:Listener' :: Maybe Protocol
protocol = forall a. Maybe a
Prelude.Nothing
    }

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

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

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

instance Data.FromJSON Listener where
  parseJSON :: Value -> Parser Listener
parseJSON =
    forall a. String -> (Object -> Parser a) -> Value -> Parser a
Data.withObject
      String
"Listener"
      ( \Object
x ->
          Maybe ClientAffinity
-> Maybe Text
-> Maybe (NonEmpty PortRange)
-> Maybe Protocol
-> Listener
Listener'
            forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> (Object
x forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data..:? Key
"ClientAffinity")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data..:? Key
"ListenerArn")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data..:? Key
"PortRanges")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data..:? Key
"Protocol")
      )

instance Prelude.Hashable Listener where
  hashWithSalt :: Int -> Listener -> Int
hashWithSalt Int
_salt Listener' {Maybe (NonEmpty PortRange)
Maybe Text
Maybe ClientAffinity
Maybe Protocol
protocol :: Maybe Protocol
portRanges :: Maybe (NonEmpty PortRange)
listenerArn :: Maybe Text
clientAffinity :: Maybe ClientAffinity
$sel:protocol:Listener' :: Listener -> Maybe Protocol
$sel:portRanges:Listener' :: Listener -> Maybe (NonEmpty PortRange)
$sel:listenerArn:Listener' :: Listener -> Maybe Text
$sel:clientAffinity:Listener' :: Listener -> 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 Text
listenerArn
      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

instance Prelude.NFData Listener where
  rnf :: Listener -> ()
rnf Listener' {Maybe (NonEmpty PortRange)
Maybe Text
Maybe ClientAffinity
Maybe Protocol
protocol :: Maybe Protocol
portRanges :: Maybe (NonEmpty PortRange)
listenerArn :: Maybe Text
clientAffinity :: Maybe ClientAffinity
$sel:protocol:Listener' :: Listener -> Maybe Protocol
$sel:portRanges:Listener' :: Listener -> Maybe (NonEmpty PortRange)
$sel:listenerArn:Listener' :: Listener -> Maybe Text
$sel:clientAffinity:Listener' :: Listener -> 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 Text
listenerArn
      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