{-# 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.AddEndpoints
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Add endpoints to an endpoint group. The @AddEndpoints@ API operation is
-- the recommended option for adding endpoints. The alternative options are
-- to add endpoints when you create an endpoint group (with the
-- <https://docs.aws.amazon.com/global-accelerator/latest/api/API_CreateEndpointGroup.html CreateEndpointGroup>
-- API) or when you update an endpoint group (with the
-- <https://docs.aws.amazon.com/global-accelerator/latest/api/API_UpdateEndpointGroup.html UpdateEndpointGroup>
-- API).
--
-- There are two advantages to using @AddEndpoints@ to add endpoints:
--
-- -   It\'s faster, because Global Accelerator only has to resolve the new
--     endpoints that you\'re adding.
--
-- -   It\'s more convenient, because you don\'t need to specify all of the
--     current endpoints that are already in the endpoint group in addition
--     to the new endpoints that you want to add.
module Amazonka.GlobalAccelerator.AddEndpoints
  ( -- * Creating a Request
    AddEndpoints (..),
    newAddEndpoints,

    -- * Request Lenses
    addEndpoints_endpointConfigurations,
    addEndpoints_endpointGroupArn,

    -- * Destructuring the Response
    AddEndpointsResponse (..),
    newAddEndpointsResponse,

    -- * Response Lenses
    addEndpointsResponse_endpointDescriptions,
    addEndpointsResponse_endpointGroupArn,
    addEndpointsResponse_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:/ 'newAddEndpoints' smart constructor.
data AddEndpoints = AddEndpoints'
  { -- | The list of endpoint objects.
    AddEndpoints -> [EndpointConfiguration]
endpointConfigurations :: [EndpointConfiguration],
    -- | The Amazon Resource Name (ARN) of the endpoint group.
    AddEndpoints -> Text
endpointGroupArn :: Prelude.Text
  }
  deriving (AddEndpoints -> AddEndpoints -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AddEndpoints -> AddEndpoints -> Bool
$c/= :: AddEndpoints -> AddEndpoints -> Bool
== :: AddEndpoints -> AddEndpoints -> Bool
$c== :: AddEndpoints -> AddEndpoints -> Bool
Prelude.Eq, ReadPrec [AddEndpoints]
ReadPrec AddEndpoints
Int -> ReadS AddEndpoints
ReadS [AddEndpoints]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [AddEndpoints]
$creadListPrec :: ReadPrec [AddEndpoints]
readPrec :: ReadPrec AddEndpoints
$creadPrec :: ReadPrec AddEndpoints
readList :: ReadS [AddEndpoints]
$creadList :: ReadS [AddEndpoints]
readsPrec :: Int -> ReadS AddEndpoints
$creadsPrec :: Int -> ReadS AddEndpoints
Prelude.Read, Int -> AddEndpoints -> ShowS
[AddEndpoints] -> ShowS
AddEndpoints -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AddEndpoints] -> ShowS
$cshowList :: [AddEndpoints] -> ShowS
show :: AddEndpoints -> String
$cshow :: AddEndpoints -> String
showsPrec :: Int -> AddEndpoints -> ShowS
$cshowsPrec :: Int -> AddEndpoints -> ShowS
Prelude.Show, forall x. Rep AddEndpoints x -> AddEndpoints
forall x. AddEndpoints -> Rep AddEndpoints x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep AddEndpoints x -> AddEndpoints
$cfrom :: forall x. AddEndpoints -> Rep AddEndpoints x
Prelude.Generic)

-- |
-- Create a value of 'AddEndpoints' 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', 'addEndpoints_endpointConfigurations' - The list of endpoint objects.
--
-- 'endpointGroupArn', 'addEndpoints_endpointGroupArn' - The Amazon Resource Name (ARN) of the endpoint group.
newAddEndpoints ::
  -- | 'endpointGroupArn'
  Prelude.Text ->
  AddEndpoints
newAddEndpoints :: Text -> AddEndpoints
newAddEndpoints Text
pEndpointGroupArn_ =
  AddEndpoints'
    { $sel:endpointConfigurations:AddEndpoints' :: [EndpointConfiguration]
endpointConfigurations =
        forall a. Monoid a => a
Prelude.mempty,
      $sel:endpointGroupArn:AddEndpoints' :: Text
endpointGroupArn = Text
pEndpointGroupArn_
    }

-- | The list of endpoint objects.
addEndpoints_endpointConfigurations :: Lens.Lens' AddEndpoints [EndpointConfiguration]
addEndpoints_endpointConfigurations :: Lens' AddEndpoints [EndpointConfiguration]
addEndpoints_endpointConfigurations = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\AddEndpoints' {[EndpointConfiguration]
endpointConfigurations :: [EndpointConfiguration]
$sel:endpointConfigurations:AddEndpoints' :: AddEndpoints -> [EndpointConfiguration]
endpointConfigurations} -> [EndpointConfiguration]
endpointConfigurations) (\s :: AddEndpoints
s@AddEndpoints' {} [EndpointConfiguration]
a -> AddEndpoints
s {$sel:endpointConfigurations:AddEndpoints' :: [EndpointConfiguration]
endpointConfigurations = [EndpointConfiguration]
a} :: AddEndpoints) 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.
addEndpoints_endpointGroupArn :: Lens.Lens' AddEndpoints Prelude.Text
addEndpoints_endpointGroupArn :: Lens' AddEndpoints Text
addEndpoints_endpointGroupArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\AddEndpoints' {Text
endpointGroupArn :: Text
$sel:endpointGroupArn:AddEndpoints' :: AddEndpoints -> Text
endpointGroupArn} -> Text
endpointGroupArn) (\s :: AddEndpoints
s@AddEndpoints' {} Text
a -> AddEndpoints
s {$sel:endpointGroupArn:AddEndpoints' :: Text
endpointGroupArn = Text
a} :: AddEndpoints)

instance Core.AWSRequest AddEndpoints where
  type AWSResponse AddEndpoints = AddEndpointsResponse
  request :: (Service -> Service) -> AddEndpoints -> Request AddEndpoints
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 AddEndpoints
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse AddEndpoints)))
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 [EndpointDescription]
-> Maybe Text -> Int -> AddEndpointsResponse
AddEndpointsResponse'
            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 AddEndpoints where
  hashWithSalt :: Int -> AddEndpoints -> Int
hashWithSalt Int
_salt AddEndpoints' {[EndpointConfiguration]
Text
endpointGroupArn :: Text
endpointConfigurations :: [EndpointConfiguration]
$sel:endpointGroupArn:AddEndpoints' :: AddEndpoints -> Text
$sel:endpointConfigurations:AddEndpoints' :: AddEndpoints -> [EndpointConfiguration]
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` [EndpointConfiguration]
endpointConfigurations
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
endpointGroupArn

instance Prelude.NFData AddEndpoints where
  rnf :: AddEndpoints -> ()
rnf AddEndpoints' {[EndpointConfiguration]
Text
endpointGroupArn :: Text
endpointConfigurations :: [EndpointConfiguration]
$sel:endpointGroupArn:AddEndpoints' :: AddEndpoints -> Text
$sel:endpointConfigurations:AddEndpoints' :: AddEndpoints -> [EndpointConfiguration]
..} =
    forall a. NFData a => a -> ()
Prelude.rnf [EndpointConfiguration]
endpointConfigurations
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
endpointGroupArn

instance Data.ToHeaders AddEndpoints where
  toHeaders :: AddEndpoints -> 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.AddEndpoints" ::
                          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 AddEndpoints where
  toJSON :: AddEndpoints -> Value
toJSON AddEndpoints' {[EndpointConfiguration]
Text
endpointGroupArn :: Text
endpointConfigurations :: [EndpointConfiguration]
$sel:endpointGroupArn:AddEndpoints' :: AddEndpoints -> Text
$sel:endpointConfigurations:AddEndpoints' :: AddEndpoints -> [EndpointConfiguration]
..} =
    [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..= [EndpointConfiguration]
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 AddEndpoints where
  toPath :: AddEndpoints -> ByteString
toPath = forall a b. a -> b -> a
Prelude.const ByteString
"/"

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

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

-- |
-- Create a value of 'AddEndpointsResponse' 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', 'addEndpointsResponse_endpointDescriptions' - The list of endpoint objects.
--
-- 'endpointGroupArn', 'addEndpointsResponse_endpointGroupArn' - The Amazon Resource Name (ARN) of the endpoint group.
--
-- 'httpStatus', 'addEndpointsResponse_httpStatus' - The response's http status code.
newAddEndpointsResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  AddEndpointsResponse
newAddEndpointsResponse :: Int -> AddEndpointsResponse
newAddEndpointsResponse Int
pHttpStatus_ =
  AddEndpointsResponse'
    { $sel:endpointDescriptions:AddEndpointsResponse' :: Maybe [EndpointDescription]
endpointDescriptions =
        forall a. Maybe a
Prelude.Nothing,
      $sel:endpointGroupArn:AddEndpointsResponse' :: Maybe Text
endpointGroupArn = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:AddEndpointsResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | The list of endpoint objects.
addEndpointsResponse_endpointDescriptions :: Lens.Lens' AddEndpointsResponse (Prelude.Maybe [EndpointDescription])
addEndpointsResponse_endpointDescriptions :: Lens' AddEndpointsResponse (Maybe [EndpointDescription])
addEndpointsResponse_endpointDescriptions = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\AddEndpointsResponse' {Maybe [EndpointDescription]
endpointDescriptions :: Maybe [EndpointDescription]
$sel:endpointDescriptions:AddEndpointsResponse' :: AddEndpointsResponse -> Maybe [EndpointDescription]
endpointDescriptions} -> Maybe [EndpointDescription]
endpointDescriptions) (\s :: AddEndpointsResponse
s@AddEndpointsResponse' {} Maybe [EndpointDescription]
a -> AddEndpointsResponse
s {$sel:endpointDescriptions:AddEndpointsResponse' :: Maybe [EndpointDescription]
endpointDescriptions = Maybe [EndpointDescription]
a} :: AddEndpointsResponse) 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.
addEndpointsResponse_endpointGroupArn :: Lens.Lens' AddEndpointsResponse (Prelude.Maybe Prelude.Text)
addEndpointsResponse_endpointGroupArn :: Lens' AddEndpointsResponse (Maybe Text)
addEndpointsResponse_endpointGroupArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\AddEndpointsResponse' {Maybe Text
endpointGroupArn :: Maybe Text
$sel:endpointGroupArn:AddEndpointsResponse' :: AddEndpointsResponse -> Maybe Text
endpointGroupArn} -> Maybe Text
endpointGroupArn) (\s :: AddEndpointsResponse
s@AddEndpointsResponse' {} Maybe Text
a -> AddEndpointsResponse
s {$sel:endpointGroupArn:AddEndpointsResponse' :: Maybe Text
endpointGroupArn = Maybe Text
a} :: AddEndpointsResponse)

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

instance Prelude.NFData AddEndpointsResponse where
  rnf :: AddEndpointsResponse -> ()
rnf AddEndpointsResponse' {Int
Maybe [EndpointDescription]
Maybe Text
httpStatus :: Int
endpointGroupArn :: Maybe Text
endpointDescriptions :: Maybe [EndpointDescription]
$sel:httpStatus:AddEndpointsResponse' :: AddEndpointsResponse -> Int
$sel:endpointGroupArn:AddEndpointsResponse' :: AddEndpointsResponse -> Maybe Text
$sel:endpointDescriptions:AddEndpointsResponse' :: AddEndpointsResponse -> Maybe [EndpointDescription]
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe [EndpointDescription]
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