{-# 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.ELBV2.ModifyListener
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Replaces the specified properties of the specified listener. Any
-- properties that you do not specify remain unchanged.
--
-- Changing the protocol from HTTPS to HTTP, or from TLS to TCP, removes
-- the security policy and default certificate properties. If you change
-- the protocol from HTTP to HTTPS, or from TCP to TLS, you must add the
-- security policy and default certificate properties.
--
-- To add an item to a list, remove an item from a list, or update an item
-- in a list, you must provide the entire list. For example, to add an
-- action, specify a list with the current actions plus the new action.
module Amazonka.ELBV2.ModifyListener
  ( -- * Creating a Request
    ModifyListener (..),
    newModifyListener,

    -- * Request Lenses
    modifyListener_alpnPolicy,
    modifyListener_certificates,
    modifyListener_defaultActions,
    modifyListener_port,
    modifyListener_protocol,
    modifyListener_sslPolicy,
    modifyListener_listenerArn,

    -- * Destructuring the Response
    ModifyListenerResponse (..),
    newModifyListenerResponse,

    -- * Response Lenses
    modifyListenerResponse_listeners,
    modifyListenerResponse_httpStatus,
  )
where

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

-- | /See:/ 'newModifyListener' smart constructor.
data ModifyListener = ModifyListener'
  { -- | [TLS listeners] The name of the Application-Layer Protocol Negotiation
    -- (ALPN) policy. You can specify one policy name. The following are the
    -- possible values:
    --
    -- -   @HTTP1Only@
    --
    -- -   @HTTP2Only@
    --
    -- -   @HTTP2Optional@
    --
    -- -   @HTTP2Preferred@
    --
    -- -   @None@
    --
    -- For more information, see
    -- <https://docs.aws.amazon.com/elasticloadbalancing/latest/network/create-tls-listener.html#alpn-policies ALPN policies>
    -- in the /Network Load Balancers Guide/.
    ModifyListener -> Maybe [Text]
alpnPolicy :: Prelude.Maybe [Prelude.Text],
    -- | [HTTPS and TLS listeners] The default certificate for the listener. You
    -- must provide exactly one certificate. Set @CertificateArn@ to the
    -- certificate ARN but do not set @IsDefault@.
    ModifyListener -> Maybe [Certificate]
certificates :: Prelude.Maybe [Certificate],
    -- | The actions for the default rule.
    ModifyListener -> Maybe [Action]
defaultActions :: Prelude.Maybe [Action],
    -- | The port for connections from clients to the load balancer. You cannot
    -- specify a port for a Gateway Load Balancer.
    ModifyListener -> Maybe Natural
port :: Prelude.Maybe Prelude.Natural,
    -- | The protocol for connections from clients to the load balancer.
    -- Application Load Balancers support the HTTP and HTTPS protocols. Network
    -- Load Balancers support the TCP, TLS, UDP, and TCP_UDP protocols. You
    -- can’t change the protocol to UDP or TCP_UDP if dual-stack mode is
    -- enabled. You cannot specify a protocol for a Gateway Load Balancer.
    ModifyListener -> Maybe ProtocolEnum
protocol :: Prelude.Maybe ProtocolEnum,
    -- | [HTTPS and TLS listeners] The security policy that defines which
    -- protocols and ciphers are supported.
    --
    -- For more information, see
    -- <https://docs.aws.amazon.com/elasticloadbalancing/latest/application/create-https-listener.html#describe-ssl-policies Security policies>
    -- in the /Application Load Balancers Guide/ or
    -- <https://docs.aws.amazon.com/elasticloadbalancing/latest/network/create-tls-listener.html#describe-ssl-policies Security policies>
    -- in the /Network Load Balancers Guide/.
    ModifyListener -> Maybe Text
sslPolicy :: Prelude.Maybe Prelude.Text,
    -- | The Amazon Resource Name (ARN) of the listener.
    ModifyListener -> Text
listenerArn :: Prelude.Text
  }
  deriving (ModifyListener -> ModifyListener -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ModifyListener -> ModifyListener -> Bool
$c/= :: ModifyListener -> ModifyListener -> Bool
== :: ModifyListener -> ModifyListener -> Bool
$c== :: ModifyListener -> ModifyListener -> Bool
Prelude.Eq, ReadPrec [ModifyListener]
ReadPrec ModifyListener
Int -> ReadS ModifyListener
ReadS [ModifyListener]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ModifyListener]
$creadListPrec :: ReadPrec [ModifyListener]
readPrec :: ReadPrec ModifyListener
$creadPrec :: ReadPrec ModifyListener
readList :: ReadS [ModifyListener]
$creadList :: ReadS [ModifyListener]
readsPrec :: Int -> ReadS ModifyListener
$creadsPrec :: Int -> ReadS ModifyListener
Prelude.Read, Int -> ModifyListener -> ShowS
[ModifyListener] -> ShowS
ModifyListener -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ModifyListener] -> ShowS
$cshowList :: [ModifyListener] -> ShowS
show :: ModifyListener -> String
$cshow :: ModifyListener -> String
showsPrec :: Int -> ModifyListener -> ShowS
$cshowsPrec :: Int -> ModifyListener -> ShowS
Prelude.Show, forall x. Rep ModifyListener x -> ModifyListener
forall x. ModifyListener -> Rep ModifyListener x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ModifyListener x -> ModifyListener
$cfrom :: forall x. ModifyListener -> Rep ModifyListener x
Prelude.Generic)

-- |
-- Create a value of 'ModifyListener' 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:
--
-- 'alpnPolicy', 'modifyListener_alpnPolicy' - [TLS listeners] The name of the Application-Layer Protocol Negotiation
-- (ALPN) policy. You can specify one policy name. The following are the
-- possible values:
--
-- -   @HTTP1Only@
--
-- -   @HTTP2Only@
--
-- -   @HTTP2Optional@
--
-- -   @HTTP2Preferred@
--
-- -   @None@
--
-- For more information, see
-- <https://docs.aws.amazon.com/elasticloadbalancing/latest/network/create-tls-listener.html#alpn-policies ALPN policies>
-- in the /Network Load Balancers Guide/.
--
-- 'certificates', 'modifyListener_certificates' - [HTTPS and TLS listeners] The default certificate for the listener. You
-- must provide exactly one certificate. Set @CertificateArn@ to the
-- certificate ARN but do not set @IsDefault@.
--
-- 'defaultActions', 'modifyListener_defaultActions' - The actions for the default rule.
--
-- 'port', 'modifyListener_port' - The port for connections from clients to the load balancer. You cannot
-- specify a port for a Gateway Load Balancer.
--
-- 'protocol', 'modifyListener_protocol' - The protocol for connections from clients to the load balancer.
-- Application Load Balancers support the HTTP and HTTPS protocols. Network
-- Load Balancers support the TCP, TLS, UDP, and TCP_UDP protocols. You
-- can’t change the protocol to UDP or TCP_UDP if dual-stack mode is
-- enabled. You cannot specify a protocol for a Gateway Load Balancer.
--
-- 'sslPolicy', 'modifyListener_sslPolicy' - [HTTPS and TLS listeners] The security policy that defines which
-- protocols and ciphers are supported.
--
-- For more information, see
-- <https://docs.aws.amazon.com/elasticloadbalancing/latest/application/create-https-listener.html#describe-ssl-policies Security policies>
-- in the /Application Load Balancers Guide/ or
-- <https://docs.aws.amazon.com/elasticloadbalancing/latest/network/create-tls-listener.html#describe-ssl-policies Security policies>
-- in the /Network Load Balancers Guide/.
--
-- 'listenerArn', 'modifyListener_listenerArn' - The Amazon Resource Name (ARN) of the listener.
newModifyListener ::
  -- | 'listenerArn'
  Prelude.Text ->
  ModifyListener
newModifyListener :: Text -> ModifyListener
newModifyListener Text
pListenerArn_ =
  ModifyListener'
    { $sel:alpnPolicy:ModifyListener' :: Maybe [Text]
alpnPolicy = forall a. Maybe a
Prelude.Nothing,
      $sel:certificates:ModifyListener' :: Maybe [Certificate]
certificates = forall a. Maybe a
Prelude.Nothing,
      $sel:defaultActions:ModifyListener' :: Maybe [Action]
defaultActions = forall a. Maybe a
Prelude.Nothing,
      $sel:port:ModifyListener' :: Maybe Natural
port = forall a. Maybe a
Prelude.Nothing,
      $sel:protocol:ModifyListener' :: Maybe ProtocolEnum
protocol = forall a. Maybe a
Prelude.Nothing,
      $sel:sslPolicy:ModifyListener' :: Maybe Text
sslPolicy = forall a. Maybe a
Prelude.Nothing,
      $sel:listenerArn:ModifyListener' :: Text
listenerArn = Text
pListenerArn_
    }

-- | [TLS listeners] The name of the Application-Layer Protocol Negotiation
-- (ALPN) policy. You can specify one policy name. The following are the
-- possible values:
--
-- -   @HTTP1Only@
--
-- -   @HTTP2Only@
--
-- -   @HTTP2Optional@
--
-- -   @HTTP2Preferred@
--
-- -   @None@
--
-- For more information, see
-- <https://docs.aws.amazon.com/elasticloadbalancing/latest/network/create-tls-listener.html#alpn-policies ALPN policies>
-- in the /Network Load Balancers Guide/.
modifyListener_alpnPolicy :: Lens.Lens' ModifyListener (Prelude.Maybe [Prelude.Text])
modifyListener_alpnPolicy :: Lens' ModifyListener (Maybe [Text])
modifyListener_alpnPolicy = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ModifyListener' {Maybe [Text]
alpnPolicy :: Maybe [Text]
$sel:alpnPolicy:ModifyListener' :: ModifyListener -> Maybe [Text]
alpnPolicy} -> Maybe [Text]
alpnPolicy) (\s :: ModifyListener
s@ModifyListener' {} Maybe [Text]
a -> ModifyListener
s {$sel:alpnPolicy:ModifyListener' :: Maybe [Text]
alpnPolicy = Maybe [Text]
a} :: ModifyListener) 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

-- | [HTTPS and TLS listeners] The default certificate for the listener. You
-- must provide exactly one certificate. Set @CertificateArn@ to the
-- certificate ARN but do not set @IsDefault@.
modifyListener_certificates :: Lens.Lens' ModifyListener (Prelude.Maybe [Certificate])
modifyListener_certificates :: Lens' ModifyListener (Maybe [Certificate])
modifyListener_certificates = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ModifyListener' {Maybe [Certificate]
certificates :: Maybe [Certificate]
$sel:certificates:ModifyListener' :: ModifyListener -> Maybe [Certificate]
certificates} -> Maybe [Certificate]
certificates) (\s :: ModifyListener
s@ModifyListener' {} Maybe [Certificate]
a -> ModifyListener
s {$sel:certificates:ModifyListener' :: Maybe [Certificate]
certificates = Maybe [Certificate]
a} :: ModifyListener) 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 actions for the default rule.
modifyListener_defaultActions :: Lens.Lens' ModifyListener (Prelude.Maybe [Action])
modifyListener_defaultActions :: Lens' ModifyListener (Maybe [Action])
modifyListener_defaultActions = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ModifyListener' {Maybe [Action]
defaultActions :: Maybe [Action]
$sel:defaultActions:ModifyListener' :: ModifyListener -> Maybe [Action]
defaultActions} -> Maybe [Action]
defaultActions) (\s :: ModifyListener
s@ModifyListener' {} Maybe [Action]
a -> ModifyListener
s {$sel:defaultActions:ModifyListener' :: Maybe [Action]
defaultActions = Maybe [Action]
a} :: ModifyListener) 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 port for connections from clients to the load balancer. You cannot
-- specify a port for a Gateway Load Balancer.
modifyListener_port :: Lens.Lens' ModifyListener (Prelude.Maybe Prelude.Natural)
modifyListener_port :: Lens' ModifyListener (Maybe Natural)
modifyListener_port = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ModifyListener' {Maybe Natural
port :: Maybe Natural
$sel:port:ModifyListener' :: ModifyListener -> Maybe Natural
port} -> Maybe Natural
port) (\s :: ModifyListener
s@ModifyListener' {} Maybe Natural
a -> ModifyListener
s {$sel:port:ModifyListener' :: Maybe Natural
port = Maybe Natural
a} :: ModifyListener)

-- | The protocol for connections from clients to the load balancer.
-- Application Load Balancers support the HTTP and HTTPS protocols. Network
-- Load Balancers support the TCP, TLS, UDP, and TCP_UDP protocols. You
-- can’t change the protocol to UDP or TCP_UDP if dual-stack mode is
-- enabled. You cannot specify a protocol for a Gateway Load Balancer.
modifyListener_protocol :: Lens.Lens' ModifyListener (Prelude.Maybe ProtocolEnum)
modifyListener_protocol :: Lens' ModifyListener (Maybe ProtocolEnum)
modifyListener_protocol = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ModifyListener' {Maybe ProtocolEnum
protocol :: Maybe ProtocolEnum
$sel:protocol:ModifyListener' :: ModifyListener -> Maybe ProtocolEnum
protocol} -> Maybe ProtocolEnum
protocol) (\s :: ModifyListener
s@ModifyListener' {} Maybe ProtocolEnum
a -> ModifyListener
s {$sel:protocol:ModifyListener' :: Maybe ProtocolEnum
protocol = Maybe ProtocolEnum
a} :: ModifyListener)

-- | [HTTPS and TLS listeners] The security policy that defines which
-- protocols and ciphers are supported.
--
-- For more information, see
-- <https://docs.aws.amazon.com/elasticloadbalancing/latest/application/create-https-listener.html#describe-ssl-policies Security policies>
-- in the /Application Load Balancers Guide/ or
-- <https://docs.aws.amazon.com/elasticloadbalancing/latest/network/create-tls-listener.html#describe-ssl-policies Security policies>
-- in the /Network Load Balancers Guide/.
modifyListener_sslPolicy :: Lens.Lens' ModifyListener (Prelude.Maybe Prelude.Text)
modifyListener_sslPolicy :: Lens' ModifyListener (Maybe Text)
modifyListener_sslPolicy = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ModifyListener' {Maybe Text
sslPolicy :: Maybe Text
$sel:sslPolicy:ModifyListener' :: ModifyListener -> Maybe Text
sslPolicy} -> Maybe Text
sslPolicy) (\s :: ModifyListener
s@ModifyListener' {} Maybe Text
a -> ModifyListener
s {$sel:sslPolicy:ModifyListener' :: Maybe Text
sslPolicy = Maybe Text
a} :: ModifyListener)

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

instance Core.AWSRequest ModifyListener where
  type
    AWSResponse ModifyListener =
      ModifyListenerResponse
  request :: (Service -> Service) -> ModifyListener -> Request ModifyListener
request Service -> Service
overrides =
    forall a. ToRequest a => Service -> a -> Request a
Request.postQuery (Service -> Service
overrides Service
defaultService)
  response :: forall (m :: * -> *).
MonadResource m =>
(ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy ModifyListener
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse ModifyListener)))
response =
    forall (m :: * -> *) a.
MonadResource m =>
Text
-> (Int
    -> ResponseHeaders -> [Node] -> Either String (AWSResponse a))
-> (ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy a
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse a)))
Response.receiveXMLWrapper
      Text
"ModifyListenerResult"
      ( \Int
s ResponseHeaders
h [Node]
x ->
          Maybe [Listener] -> Int -> ModifyListenerResponse
ModifyListenerResponse'
            forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> ( [Node]
x
                            forall a. FromXML a => [Node] -> Text -> Either String (Maybe a)
Data..@? Text
"Listeners"
                            forall (f :: * -> *) a. Functor f => f (Maybe a) -> a -> f a
Core..!@ forall a. Monoid a => a
Prelude.mempty
                            forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
Prelude.>>= forall (f :: * -> *) a b.
Applicative f =>
([a] -> f b) -> [a] -> f (Maybe b)
Core.may (forall a. FromXML a => Text -> [Node] -> Either String [a]
Data.parseXMLList Text
"member")
                        )
            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 ModifyListener where
  hashWithSalt :: Int -> ModifyListener -> Int
hashWithSalt Int
_salt ModifyListener' {Maybe Natural
Maybe [Text]
Maybe [Certificate]
Maybe [Action]
Maybe Text
Maybe ProtocolEnum
Text
listenerArn :: Text
sslPolicy :: Maybe Text
protocol :: Maybe ProtocolEnum
port :: Maybe Natural
defaultActions :: Maybe [Action]
certificates :: Maybe [Certificate]
alpnPolicy :: Maybe [Text]
$sel:listenerArn:ModifyListener' :: ModifyListener -> Text
$sel:sslPolicy:ModifyListener' :: ModifyListener -> Maybe Text
$sel:protocol:ModifyListener' :: ModifyListener -> Maybe ProtocolEnum
$sel:port:ModifyListener' :: ModifyListener -> Maybe Natural
$sel:defaultActions:ModifyListener' :: ModifyListener -> Maybe [Action]
$sel:certificates:ModifyListener' :: ModifyListener -> Maybe [Certificate]
$sel:alpnPolicy:ModifyListener' :: ModifyListener -> Maybe [Text]
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [Text]
alpnPolicy
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [Certificate]
certificates
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [Action]
defaultActions
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Natural
port
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe ProtocolEnum
protocol
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
sslPolicy
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
listenerArn

instance Prelude.NFData ModifyListener where
  rnf :: ModifyListener -> ()
rnf ModifyListener' {Maybe Natural
Maybe [Text]
Maybe [Certificate]
Maybe [Action]
Maybe Text
Maybe ProtocolEnum
Text
listenerArn :: Text
sslPolicy :: Maybe Text
protocol :: Maybe ProtocolEnum
port :: Maybe Natural
defaultActions :: Maybe [Action]
certificates :: Maybe [Certificate]
alpnPolicy :: Maybe [Text]
$sel:listenerArn:ModifyListener' :: ModifyListener -> Text
$sel:sslPolicy:ModifyListener' :: ModifyListener -> Maybe Text
$sel:protocol:ModifyListener' :: ModifyListener -> Maybe ProtocolEnum
$sel:port:ModifyListener' :: ModifyListener -> Maybe Natural
$sel:defaultActions:ModifyListener' :: ModifyListener -> Maybe [Action]
$sel:certificates:ModifyListener' :: ModifyListener -> Maybe [Certificate]
$sel:alpnPolicy:ModifyListener' :: ModifyListener -> Maybe [Text]
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe [Text]
alpnPolicy
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [Certificate]
certificates
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [Action]
defaultActions
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Natural
port
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe ProtocolEnum
protocol
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
sslPolicy
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
listenerArn

instance Data.ToHeaders ModifyListener where
  toHeaders :: ModifyListener -> ResponseHeaders
toHeaders = forall a b. a -> b -> a
Prelude.const forall a. Monoid a => a
Prelude.mempty

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

instance Data.ToQuery ModifyListener where
  toQuery :: ModifyListener -> QueryString
toQuery ModifyListener' {Maybe Natural
Maybe [Text]
Maybe [Certificate]
Maybe [Action]
Maybe Text
Maybe ProtocolEnum
Text
listenerArn :: Text
sslPolicy :: Maybe Text
protocol :: Maybe ProtocolEnum
port :: Maybe Natural
defaultActions :: Maybe [Action]
certificates :: Maybe [Certificate]
alpnPolicy :: Maybe [Text]
$sel:listenerArn:ModifyListener' :: ModifyListener -> Text
$sel:sslPolicy:ModifyListener' :: ModifyListener -> Maybe Text
$sel:protocol:ModifyListener' :: ModifyListener -> Maybe ProtocolEnum
$sel:port:ModifyListener' :: ModifyListener -> Maybe Natural
$sel:defaultActions:ModifyListener' :: ModifyListener -> Maybe [Action]
$sel:certificates:ModifyListener' :: ModifyListener -> Maybe [Certificate]
$sel:alpnPolicy:ModifyListener' :: ModifyListener -> Maybe [Text]
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"Action"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: (ByteString
"ModifyListener" :: Prelude.ByteString),
        ByteString
"Version"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: (ByteString
"2015-12-01" :: Prelude.ByteString),
        ByteString
"AlpnPolicy"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: forall a. ToQuery a => a -> QueryString
Data.toQuery
            (forall a.
(IsList a, ToQuery (Item a)) =>
ByteString -> a -> QueryString
Data.toQueryList ByteString
"member" forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe [Text]
alpnPolicy),
        ByteString
"Certificates"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: forall a. ToQuery a => a -> QueryString
Data.toQuery
            (forall a.
(IsList a, ToQuery (Item a)) =>
ByteString -> a -> QueryString
Data.toQueryList ByteString
"member" forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe [Certificate]
certificates),
        ByteString
"DefaultActions"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: forall a. ToQuery a => a -> QueryString
Data.toQuery
            ( forall a.
(IsList a, ToQuery (Item a)) =>
ByteString -> a -> QueryString
Data.toQueryList ByteString
"member"
                forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe [Action]
defaultActions
            ),
        ByteString
"Port" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Natural
port,
        ByteString
"Protocol" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe ProtocolEnum
protocol,
        ByteString
"SslPolicy" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Text
sslPolicy,
        ByteString
"ListenerArn" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Text
listenerArn
      ]

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

-- |
-- Create a value of 'ModifyListenerResponse' 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:
--
-- 'listeners', 'modifyListenerResponse_listeners' - Information about the modified listener.
--
-- 'httpStatus', 'modifyListenerResponse_httpStatus' - The response's http status code.
newModifyListenerResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  ModifyListenerResponse
newModifyListenerResponse :: Int -> ModifyListenerResponse
newModifyListenerResponse Int
pHttpStatus_ =
  ModifyListenerResponse'
    { $sel:listeners:ModifyListenerResponse' :: Maybe [Listener]
listeners =
        forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:ModifyListenerResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | Information about the modified listener.
modifyListenerResponse_listeners :: Lens.Lens' ModifyListenerResponse (Prelude.Maybe [Listener])
modifyListenerResponse_listeners :: Lens' ModifyListenerResponse (Maybe [Listener])
modifyListenerResponse_listeners = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ModifyListenerResponse' {Maybe [Listener]
listeners :: Maybe [Listener]
$sel:listeners:ModifyListenerResponse' :: ModifyListenerResponse -> Maybe [Listener]
listeners} -> Maybe [Listener]
listeners) (\s :: ModifyListenerResponse
s@ModifyListenerResponse' {} Maybe [Listener]
a -> ModifyListenerResponse
s {$sel:listeners:ModifyListenerResponse' :: Maybe [Listener]
listeners = Maybe [Listener]
a} :: ModifyListenerResponse) 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.
modifyListenerResponse_httpStatus :: Lens.Lens' ModifyListenerResponse Prelude.Int
modifyListenerResponse_httpStatus :: Lens' ModifyListenerResponse Int
modifyListenerResponse_httpStatus = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ModifyListenerResponse' {Int
httpStatus :: Int
$sel:httpStatus:ModifyListenerResponse' :: ModifyListenerResponse -> Int
httpStatus} -> Int
httpStatus) (\s :: ModifyListenerResponse
s@ModifyListenerResponse' {} Int
a -> ModifyListenerResponse
s {$sel:httpStatus:ModifyListenerResponse' :: Int
httpStatus = Int
a} :: ModifyListenerResponse)

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