{-# 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.AddCustomRoutingEndpoints
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Associate a virtual private cloud (VPC) subnet endpoint with your custom
-- routing accelerator.
--
-- The listener port range must be large enough to support the number of IP
-- addresses that can be specified in your subnet. The number of ports
-- required is: subnet size times the number of ports per destination EC2
-- instances. For example, a subnet defined as \/24 requires a listener
-- port range of at least 255 ports.
--
-- Note: You must have enough remaining listener ports available to map to
-- the subnet ports, or the call will fail with a LimitExceededException.
--
-- By default, all destinations in a subnet in a custom routing accelerator
-- cannot receive traffic. To enable all destinations to receive traffic,
-- or to specify individual port mappings that can receive traffic, see the
-- <https://docs.aws.amazon.com/global-accelerator/latest/api/API_AllowCustomRoutingTraffic.html AllowCustomRoutingTraffic>
-- operation.
module Amazonka.GlobalAccelerator.AddCustomRoutingEndpoints
  ( -- * Creating a Request
    AddCustomRoutingEndpoints (..),
    newAddCustomRoutingEndpoints,

    -- * Request Lenses
    addCustomRoutingEndpoints_endpointConfigurations,
    addCustomRoutingEndpoints_endpointGroupArn,

    -- * Destructuring the Response
    AddCustomRoutingEndpointsResponse (..),
    newAddCustomRoutingEndpointsResponse,

    -- * Response Lenses
    addCustomRoutingEndpointsResponse_endpointDescriptions,
    addCustomRoutingEndpointsResponse_endpointGroupArn,
    addCustomRoutingEndpointsResponse_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:/ 'newAddCustomRoutingEndpoints' smart constructor.
data AddCustomRoutingEndpoints = AddCustomRoutingEndpoints'
  { -- | The list of endpoint objects to add to a custom routing accelerator.
    AddCustomRoutingEndpoints
-> NonEmpty CustomRoutingEndpointConfiguration
endpointConfigurations :: Prelude.NonEmpty CustomRoutingEndpointConfiguration,
    -- | The Amazon Resource Name (ARN) of the endpoint group for the custom
    -- routing endpoint.
    AddCustomRoutingEndpoints -> Text
endpointGroupArn :: Prelude.Text
  }
  deriving (AddCustomRoutingEndpoints -> AddCustomRoutingEndpoints -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AddCustomRoutingEndpoints -> AddCustomRoutingEndpoints -> Bool
$c/= :: AddCustomRoutingEndpoints -> AddCustomRoutingEndpoints -> Bool
== :: AddCustomRoutingEndpoints -> AddCustomRoutingEndpoints -> Bool
$c== :: AddCustomRoutingEndpoints -> AddCustomRoutingEndpoints -> Bool
Prelude.Eq, ReadPrec [AddCustomRoutingEndpoints]
ReadPrec AddCustomRoutingEndpoints
Int -> ReadS AddCustomRoutingEndpoints
ReadS [AddCustomRoutingEndpoints]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [AddCustomRoutingEndpoints]
$creadListPrec :: ReadPrec [AddCustomRoutingEndpoints]
readPrec :: ReadPrec AddCustomRoutingEndpoints
$creadPrec :: ReadPrec AddCustomRoutingEndpoints
readList :: ReadS [AddCustomRoutingEndpoints]
$creadList :: ReadS [AddCustomRoutingEndpoints]
readsPrec :: Int -> ReadS AddCustomRoutingEndpoints
$creadsPrec :: Int -> ReadS AddCustomRoutingEndpoints
Prelude.Read, Int -> AddCustomRoutingEndpoints -> ShowS
[AddCustomRoutingEndpoints] -> ShowS
AddCustomRoutingEndpoints -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AddCustomRoutingEndpoints] -> ShowS
$cshowList :: [AddCustomRoutingEndpoints] -> ShowS
show :: AddCustomRoutingEndpoints -> String
$cshow :: AddCustomRoutingEndpoints -> String
showsPrec :: Int -> AddCustomRoutingEndpoints -> ShowS
$cshowsPrec :: Int -> AddCustomRoutingEndpoints -> ShowS
Prelude.Show, forall x.
Rep AddCustomRoutingEndpoints x -> AddCustomRoutingEndpoints
forall x.
AddCustomRoutingEndpoints -> Rep AddCustomRoutingEndpoints x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep AddCustomRoutingEndpoints x -> AddCustomRoutingEndpoints
$cfrom :: forall x.
AddCustomRoutingEndpoints -> Rep AddCustomRoutingEndpoints x
Prelude.Generic)

-- |
-- Create a value of 'AddCustomRoutingEndpoints' 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:
--
-- 'endpointConfigurations', 'addCustomRoutingEndpoints_endpointConfigurations' - The list of endpoint objects to add to a custom routing accelerator.
--
-- 'endpointGroupArn', 'addCustomRoutingEndpoints_endpointGroupArn' - The Amazon Resource Name (ARN) of the endpoint group for the custom
-- routing endpoint.
newAddCustomRoutingEndpoints ::
  -- | 'endpointConfigurations'
  Prelude.NonEmpty CustomRoutingEndpointConfiguration ->
  -- | 'endpointGroupArn'
  Prelude.Text ->
  AddCustomRoutingEndpoints
newAddCustomRoutingEndpoints :: NonEmpty CustomRoutingEndpointConfiguration
-> Text -> AddCustomRoutingEndpoints
newAddCustomRoutingEndpoints
  NonEmpty CustomRoutingEndpointConfiguration
pEndpointConfigurations_
  Text
pEndpointGroupArn_ =
    AddCustomRoutingEndpoints'
      { $sel:endpointConfigurations:AddCustomRoutingEndpoints' :: NonEmpty CustomRoutingEndpointConfiguration
endpointConfigurations =
          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 CustomRoutingEndpointConfiguration
pEndpointConfigurations_,
        $sel:endpointGroupArn:AddCustomRoutingEndpoints' :: Text
endpointGroupArn = Text
pEndpointGroupArn_
      }

-- | The list of endpoint objects to add to a custom routing accelerator.
addCustomRoutingEndpoints_endpointConfigurations :: Lens.Lens' AddCustomRoutingEndpoints (Prelude.NonEmpty CustomRoutingEndpointConfiguration)
addCustomRoutingEndpoints_endpointConfigurations :: Lens'
  AddCustomRoutingEndpoints
  (NonEmpty CustomRoutingEndpointConfiguration)
addCustomRoutingEndpoints_endpointConfigurations = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\AddCustomRoutingEndpoints' {NonEmpty CustomRoutingEndpointConfiguration
endpointConfigurations :: NonEmpty CustomRoutingEndpointConfiguration
$sel:endpointConfigurations:AddCustomRoutingEndpoints' :: AddCustomRoutingEndpoints
-> NonEmpty CustomRoutingEndpointConfiguration
endpointConfigurations} -> NonEmpty CustomRoutingEndpointConfiguration
endpointConfigurations) (\s :: AddCustomRoutingEndpoints
s@AddCustomRoutingEndpoints' {} NonEmpty CustomRoutingEndpointConfiguration
a -> AddCustomRoutingEndpoints
s {$sel:endpointConfigurations:AddCustomRoutingEndpoints' :: NonEmpty CustomRoutingEndpointConfiguration
endpointConfigurations = NonEmpty CustomRoutingEndpointConfiguration
a} :: AddCustomRoutingEndpoints) 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 Amazon Resource Name (ARN) of the endpoint group for the custom
-- routing endpoint.
addCustomRoutingEndpoints_endpointGroupArn :: Lens.Lens' AddCustomRoutingEndpoints Prelude.Text
addCustomRoutingEndpoints_endpointGroupArn :: Lens' AddCustomRoutingEndpoints Text
addCustomRoutingEndpoints_endpointGroupArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\AddCustomRoutingEndpoints' {Text
endpointGroupArn :: Text
$sel:endpointGroupArn:AddCustomRoutingEndpoints' :: AddCustomRoutingEndpoints -> Text
endpointGroupArn} -> Text
endpointGroupArn) (\s :: AddCustomRoutingEndpoints
s@AddCustomRoutingEndpoints' {} Text
a -> AddCustomRoutingEndpoints
s {$sel:endpointGroupArn:AddCustomRoutingEndpoints' :: Text
endpointGroupArn = Text
a} :: AddCustomRoutingEndpoints)

instance Core.AWSRequest AddCustomRoutingEndpoints where
  type
    AWSResponse AddCustomRoutingEndpoints =
      AddCustomRoutingEndpointsResponse
  request :: (Service -> Service)
-> AddCustomRoutingEndpoints -> Request AddCustomRoutingEndpoints
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 AddCustomRoutingEndpoints
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse AddCustomRoutingEndpoints)))
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 [CustomRoutingEndpointDescription]
-> Maybe Text -> Int -> AddCustomRoutingEndpointsResponse
AddCustomRoutingEndpointsResponse'
            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
"EndpointDescriptions"
                            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.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"EndpointGroupArn")
            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 AddCustomRoutingEndpoints where
  hashWithSalt :: Int -> AddCustomRoutingEndpoints -> Int
hashWithSalt Int
_salt AddCustomRoutingEndpoints' {NonEmpty CustomRoutingEndpointConfiguration
Text
endpointGroupArn :: Text
endpointConfigurations :: NonEmpty CustomRoutingEndpointConfiguration
$sel:endpointGroupArn:AddCustomRoutingEndpoints' :: AddCustomRoutingEndpoints -> Text
$sel:endpointConfigurations:AddCustomRoutingEndpoints' :: AddCustomRoutingEndpoints
-> NonEmpty CustomRoutingEndpointConfiguration
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` NonEmpty CustomRoutingEndpointConfiguration
endpointConfigurations
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
endpointGroupArn

instance Prelude.NFData AddCustomRoutingEndpoints where
  rnf :: AddCustomRoutingEndpoints -> ()
rnf AddCustomRoutingEndpoints' {NonEmpty CustomRoutingEndpointConfiguration
Text
endpointGroupArn :: Text
endpointConfigurations :: NonEmpty CustomRoutingEndpointConfiguration
$sel:endpointGroupArn:AddCustomRoutingEndpoints' :: AddCustomRoutingEndpoints -> Text
$sel:endpointConfigurations:AddCustomRoutingEndpoints' :: AddCustomRoutingEndpoints
-> NonEmpty CustomRoutingEndpointConfiguration
..} =
    forall a. NFData a => a -> ()
Prelude.rnf NonEmpty CustomRoutingEndpointConfiguration
endpointConfigurations
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
endpointGroupArn

instance Data.ToHeaders AddCustomRoutingEndpoints where
  toHeaders :: AddCustomRoutingEndpoints -> 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.AddCustomRoutingEndpoints" ::
                          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 AddCustomRoutingEndpoints where
  toJSON :: AddCustomRoutingEndpoints -> Value
toJSON AddCustomRoutingEndpoints' {NonEmpty CustomRoutingEndpointConfiguration
Text
endpointGroupArn :: Text
endpointConfigurations :: NonEmpty CustomRoutingEndpointConfiguration
$sel:endpointGroupArn:AddCustomRoutingEndpoints' :: AddCustomRoutingEndpoints -> Text
$sel:endpointConfigurations:AddCustomRoutingEndpoints' :: AddCustomRoutingEndpoints
-> NonEmpty CustomRoutingEndpointConfiguration
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ forall a. a -> Maybe a
Prelude.Just
              ( Key
"EndpointConfigurations"
                  forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= NonEmpty CustomRoutingEndpointConfiguration
endpointConfigurations
              ),
            forall a. a -> Maybe a
Prelude.Just
              (Key
"EndpointGroupArn" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
endpointGroupArn)
          ]
      )

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

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

-- | /See:/ 'newAddCustomRoutingEndpointsResponse' smart constructor.
data AddCustomRoutingEndpointsResponse = AddCustomRoutingEndpointsResponse'
  { -- | The endpoint objects added to the custom routing accelerator.
    AddCustomRoutingEndpointsResponse
-> Maybe [CustomRoutingEndpointDescription]
endpointDescriptions :: Prelude.Maybe [CustomRoutingEndpointDescription],
    -- | The Amazon Resource Name (ARN) of the endpoint group for the custom
    -- routing endpoint.
    AddCustomRoutingEndpointsResponse -> Maybe Text
endpointGroupArn :: Prelude.Maybe Prelude.Text,
    -- | The response's http status code.
    AddCustomRoutingEndpointsResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (AddCustomRoutingEndpointsResponse
-> AddCustomRoutingEndpointsResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AddCustomRoutingEndpointsResponse
-> AddCustomRoutingEndpointsResponse -> Bool
$c/= :: AddCustomRoutingEndpointsResponse
-> AddCustomRoutingEndpointsResponse -> Bool
== :: AddCustomRoutingEndpointsResponse
-> AddCustomRoutingEndpointsResponse -> Bool
$c== :: AddCustomRoutingEndpointsResponse
-> AddCustomRoutingEndpointsResponse -> Bool
Prelude.Eq, ReadPrec [AddCustomRoutingEndpointsResponse]
ReadPrec AddCustomRoutingEndpointsResponse
Int -> ReadS AddCustomRoutingEndpointsResponse
ReadS [AddCustomRoutingEndpointsResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [AddCustomRoutingEndpointsResponse]
$creadListPrec :: ReadPrec [AddCustomRoutingEndpointsResponse]
readPrec :: ReadPrec AddCustomRoutingEndpointsResponse
$creadPrec :: ReadPrec AddCustomRoutingEndpointsResponse
readList :: ReadS [AddCustomRoutingEndpointsResponse]
$creadList :: ReadS [AddCustomRoutingEndpointsResponse]
readsPrec :: Int -> ReadS AddCustomRoutingEndpointsResponse
$creadsPrec :: Int -> ReadS AddCustomRoutingEndpointsResponse
Prelude.Read, Int -> AddCustomRoutingEndpointsResponse -> ShowS
[AddCustomRoutingEndpointsResponse] -> ShowS
AddCustomRoutingEndpointsResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AddCustomRoutingEndpointsResponse] -> ShowS
$cshowList :: [AddCustomRoutingEndpointsResponse] -> ShowS
show :: AddCustomRoutingEndpointsResponse -> String
$cshow :: AddCustomRoutingEndpointsResponse -> String
showsPrec :: Int -> AddCustomRoutingEndpointsResponse -> ShowS
$cshowsPrec :: Int -> AddCustomRoutingEndpointsResponse -> ShowS
Prelude.Show, forall x.
Rep AddCustomRoutingEndpointsResponse x
-> AddCustomRoutingEndpointsResponse
forall x.
AddCustomRoutingEndpointsResponse
-> Rep AddCustomRoutingEndpointsResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep AddCustomRoutingEndpointsResponse x
-> AddCustomRoutingEndpointsResponse
$cfrom :: forall x.
AddCustomRoutingEndpointsResponse
-> Rep AddCustomRoutingEndpointsResponse x
Prelude.Generic)

-- |
-- Create a value of 'AddCustomRoutingEndpointsResponse' 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:
--
-- 'endpointDescriptions', 'addCustomRoutingEndpointsResponse_endpointDescriptions' - The endpoint objects added to the custom routing accelerator.
--
-- 'endpointGroupArn', 'addCustomRoutingEndpointsResponse_endpointGroupArn' - The Amazon Resource Name (ARN) of the endpoint group for the custom
-- routing endpoint.
--
-- 'httpStatus', 'addCustomRoutingEndpointsResponse_httpStatus' - The response's http status code.
newAddCustomRoutingEndpointsResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  AddCustomRoutingEndpointsResponse
newAddCustomRoutingEndpointsResponse :: Int -> AddCustomRoutingEndpointsResponse
newAddCustomRoutingEndpointsResponse Int
pHttpStatus_ =
  AddCustomRoutingEndpointsResponse'
    { $sel:endpointDescriptions:AddCustomRoutingEndpointsResponse' :: Maybe [CustomRoutingEndpointDescription]
endpointDescriptions =
        forall a. Maybe a
Prelude.Nothing,
      $sel:endpointGroupArn:AddCustomRoutingEndpointsResponse' :: Maybe Text
endpointGroupArn = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:AddCustomRoutingEndpointsResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | The endpoint objects added to the custom routing accelerator.
addCustomRoutingEndpointsResponse_endpointDescriptions :: Lens.Lens' AddCustomRoutingEndpointsResponse (Prelude.Maybe [CustomRoutingEndpointDescription])
addCustomRoutingEndpointsResponse_endpointDescriptions :: Lens'
  AddCustomRoutingEndpointsResponse
  (Maybe [CustomRoutingEndpointDescription])
addCustomRoutingEndpointsResponse_endpointDescriptions = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\AddCustomRoutingEndpointsResponse' {Maybe [CustomRoutingEndpointDescription]
endpointDescriptions :: Maybe [CustomRoutingEndpointDescription]
$sel:endpointDescriptions:AddCustomRoutingEndpointsResponse' :: AddCustomRoutingEndpointsResponse
-> Maybe [CustomRoutingEndpointDescription]
endpointDescriptions} -> Maybe [CustomRoutingEndpointDescription]
endpointDescriptions) (\s :: AddCustomRoutingEndpointsResponse
s@AddCustomRoutingEndpointsResponse' {} Maybe [CustomRoutingEndpointDescription]
a -> AddCustomRoutingEndpointsResponse
s {$sel:endpointDescriptions:AddCustomRoutingEndpointsResponse' :: Maybe [CustomRoutingEndpointDescription]
endpointDescriptions = Maybe [CustomRoutingEndpointDescription]
a} :: AddCustomRoutingEndpointsResponse) 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 Amazon Resource Name (ARN) of the endpoint group for the custom
-- routing endpoint.
addCustomRoutingEndpointsResponse_endpointGroupArn :: Lens.Lens' AddCustomRoutingEndpointsResponse (Prelude.Maybe Prelude.Text)
addCustomRoutingEndpointsResponse_endpointGroupArn :: Lens' AddCustomRoutingEndpointsResponse (Maybe Text)
addCustomRoutingEndpointsResponse_endpointGroupArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\AddCustomRoutingEndpointsResponse' {Maybe Text
endpointGroupArn :: Maybe Text
$sel:endpointGroupArn:AddCustomRoutingEndpointsResponse' :: AddCustomRoutingEndpointsResponse -> Maybe Text
endpointGroupArn} -> Maybe Text
endpointGroupArn) (\s :: AddCustomRoutingEndpointsResponse
s@AddCustomRoutingEndpointsResponse' {} Maybe Text
a -> AddCustomRoutingEndpointsResponse
s {$sel:endpointGroupArn:AddCustomRoutingEndpointsResponse' :: Maybe Text
endpointGroupArn = Maybe Text
a} :: AddCustomRoutingEndpointsResponse)

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

instance
  Prelude.NFData
    AddCustomRoutingEndpointsResponse
  where
  rnf :: AddCustomRoutingEndpointsResponse -> ()
rnf AddCustomRoutingEndpointsResponse' {Int
Maybe [CustomRoutingEndpointDescription]
Maybe Text
httpStatus :: Int
endpointGroupArn :: Maybe Text
endpointDescriptions :: Maybe [CustomRoutingEndpointDescription]
$sel:httpStatus:AddCustomRoutingEndpointsResponse' :: AddCustomRoutingEndpointsResponse -> Int
$sel:endpointGroupArn:AddCustomRoutingEndpointsResponse' :: AddCustomRoutingEndpointsResponse -> Maybe Text
$sel:endpointDescriptions:AddCustomRoutingEndpointsResponse' :: AddCustomRoutingEndpointsResponse
-> Maybe [CustomRoutingEndpointDescription]
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe [CustomRoutingEndpointDescription]
endpointDescriptions
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
endpointGroupArn
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus