{-# 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.RemoveCustomRoutingEndpoints
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Remove endpoints from a custom routing accelerator.
module Amazonka.GlobalAccelerator.RemoveCustomRoutingEndpoints
  ( -- * Creating a Request
    RemoveCustomRoutingEndpoints (..),
    newRemoveCustomRoutingEndpoints,

    -- * Request Lenses
    removeCustomRoutingEndpoints_endpointIds,
    removeCustomRoutingEndpoints_endpointGroupArn,

    -- * Destructuring the Response
    RemoveCustomRoutingEndpointsResponse (..),
    newRemoveCustomRoutingEndpointsResponse,
  )
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:/ 'newRemoveCustomRoutingEndpoints' smart constructor.
data RemoveCustomRoutingEndpoints = RemoveCustomRoutingEndpoints'
  { -- | The IDs for the endpoints. For custom routing accelerators, endpoint IDs
    -- are the virtual private cloud (VPC) subnet IDs.
    RemoveCustomRoutingEndpoints -> [Text]
endpointIds :: [Prelude.Text],
    -- | The Amazon Resource Name (ARN) of the endpoint group to remove endpoints
    -- from.
    RemoveCustomRoutingEndpoints -> Text
endpointGroupArn :: Prelude.Text
  }
  deriving (RemoveCustomRoutingEndpoints
-> RemoveCustomRoutingEndpoints -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RemoveCustomRoutingEndpoints
-> RemoveCustomRoutingEndpoints -> Bool
$c/= :: RemoveCustomRoutingEndpoints
-> RemoveCustomRoutingEndpoints -> Bool
== :: RemoveCustomRoutingEndpoints
-> RemoveCustomRoutingEndpoints -> Bool
$c== :: RemoveCustomRoutingEndpoints
-> RemoveCustomRoutingEndpoints -> Bool
Prelude.Eq, ReadPrec [RemoveCustomRoutingEndpoints]
ReadPrec RemoveCustomRoutingEndpoints
Int -> ReadS RemoveCustomRoutingEndpoints
ReadS [RemoveCustomRoutingEndpoints]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [RemoveCustomRoutingEndpoints]
$creadListPrec :: ReadPrec [RemoveCustomRoutingEndpoints]
readPrec :: ReadPrec RemoveCustomRoutingEndpoints
$creadPrec :: ReadPrec RemoveCustomRoutingEndpoints
readList :: ReadS [RemoveCustomRoutingEndpoints]
$creadList :: ReadS [RemoveCustomRoutingEndpoints]
readsPrec :: Int -> ReadS RemoveCustomRoutingEndpoints
$creadsPrec :: Int -> ReadS RemoveCustomRoutingEndpoints
Prelude.Read, Int -> RemoveCustomRoutingEndpoints -> ShowS
[RemoveCustomRoutingEndpoints] -> ShowS
RemoveCustomRoutingEndpoints -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RemoveCustomRoutingEndpoints] -> ShowS
$cshowList :: [RemoveCustomRoutingEndpoints] -> ShowS
show :: RemoveCustomRoutingEndpoints -> String
$cshow :: RemoveCustomRoutingEndpoints -> String
showsPrec :: Int -> RemoveCustomRoutingEndpoints -> ShowS
$cshowsPrec :: Int -> RemoveCustomRoutingEndpoints -> ShowS
Prelude.Show, forall x.
Rep RemoveCustomRoutingEndpoints x -> RemoveCustomRoutingEndpoints
forall x.
RemoveCustomRoutingEndpoints -> Rep RemoveCustomRoutingEndpoints x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep RemoveCustomRoutingEndpoints x -> RemoveCustomRoutingEndpoints
$cfrom :: forall x.
RemoveCustomRoutingEndpoints -> Rep RemoveCustomRoutingEndpoints x
Prelude.Generic)

-- |
-- Create a value of 'RemoveCustomRoutingEndpoints' 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:
--
-- 'endpointIds', 'removeCustomRoutingEndpoints_endpointIds' - The IDs for the endpoints. For custom routing accelerators, endpoint IDs
-- are the virtual private cloud (VPC) subnet IDs.
--
-- 'endpointGroupArn', 'removeCustomRoutingEndpoints_endpointGroupArn' - The Amazon Resource Name (ARN) of the endpoint group to remove endpoints
-- from.
newRemoveCustomRoutingEndpoints ::
  -- | 'endpointGroupArn'
  Prelude.Text ->
  RemoveCustomRoutingEndpoints
newRemoveCustomRoutingEndpoints :: Text -> RemoveCustomRoutingEndpoints
newRemoveCustomRoutingEndpoints Text
pEndpointGroupArn_ =
  RemoveCustomRoutingEndpoints'
    { $sel:endpointIds:RemoveCustomRoutingEndpoints' :: [Text]
endpointIds =
        forall a. Monoid a => a
Prelude.mempty,
      $sel:endpointGroupArn:RemoveCustomRoutingEndpoints' :: Text
endpointGroupArn = Text
pEndpointGroupArn_
    }

-- | The IDs for the endpoints. For custom routing accelerators, endpoint IDs
-- are the virtual private cloud (VPC) subnet IDs.
removeCustomRoutingEndpoints_endpointIds :: Lens.Lens' RemoveCustomRoutingEndpoints [Prelude.Text]
removeCustomRoutingEndpoints_endpointIds :: Lens' RemoveCustomRoutingEndpoints [Text]
removeCustomRoutingEndpoints_endpointIds = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\RemoveCustomRoutingEndpoints' {[Text]
endpointIds :: [Text]
$sel:endpointIds:RemoveCustomRoutingEndpoints' :: RemoveCustomRoutingEndpoints -> [Text]
endpointIds} -> [Text]
endpointIds) (\s :: RemoveCustomRoutingEndpoints
s@RemoveCustomRoutingEndpoints' {} [Text]
a -> RemoveCustomRoutingEndpoints
s {$sel:endpointIds:RemoveCustomRoutingEndpoints' :: [Text]
endpointIds = [Text]
a} :: RemoveCustomRoutingEndpoints) 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 to remove endpoints
-- from.
removeCustomRoutingEndpoints_endpointGroupArn :: Lens.Lens' RemoveCustomRoutingEndpoints Prelude.Text
removeCustomRoutingEndpoints_endpointGroupArn :: Lens' RemoveCustomRoutingEndpoints Text
removeCustomRoutingEndpoints_endpointGroupArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\RemoveCustomRoutingEndpoints' {Text
endpointGroupArn :: Text
$sel:endpointGroupArn:RemoveCustomRoutingEndpoints' :: RemoveCustomRoutingEndpoints -> Text
endpointGroupArn} -> Text
endpointGroupArn) (\s :: RemoveCustomRoutingEndpoints
s@RemoveCustomRoutingEndpoints' {} Text
a -> RemoveCustomRoutingEndpoints
s {$sel:endpointGroupArn:RemoveCustomRoutingEndpoints' :: Text
endpointGroupArn = Text
a} :: RemoveCustomRoutingEndpoints)

instance Core.AWSRequest RemoveCustomRoutingEndpoints where
  type
    AWSResponse RemoveCustomRoutingEndpoints =
      RemoveCustomRoutingEndpointsResponse
  request :: (Service -> Service)
-> RemoveCustomRoutingEndpoints
-> Request RemoveCustomRoutingEndpoints
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 RemoveCustomRoutingEndpoints
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse RemoveCustomRoutingEndpoints)))
response =
    forall (m :: * -> *) a.
MonadResource m =>
AWSResponse a
-> (ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy a
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse a)))
Response.receiveNull
      RemoveCustomRoutingEndpointsResponse
RemoveCustomRoutingEndpointsResponse'

instance
  Prelude.Hashable
    RemoveCustomRoutingEndpoints
  where
  hashWithSalt :: Int -> RemoveCustomRoutingEndpoints -> Int
hashWithSalt Int
_salt RemoveCustomRoutingEndpoints' {[Text]
Text
endpointGroupArn :: Text
endpointIds :: [Text]
$sel:endpointGroupArn:RemoveCustomRoutingEndpoints' :: RemoveCustomRoutingEndpoints -> Text
$sel:endpointIds:RemoveCustomRoutingEndpoints' :: RemoveCustomRoutingEndpoints -> [Text]
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` [Text]
endpointIds
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
endpointGroupArn

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

instance Data.ToHeaders RemoveCustomRoutingEndpoints where
  toHeaders :: RemoveCustomRoutingEndpoints -> [Header]
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 -> [Header]
Data.=# ( ByteString
"GlobalAccelerator_V20180706.RemoveCustomRoutingEndpoints" ::
                          Prelude.ByteString
                      ),
            HeaderName
"Content-Type"
              forall a. ToHeader a => HeaderName -> a -> [Header]
Data.=# ( ByteString
"application/x-amz-json-1.1" ::
                          Prelude.ByteString
                      )
          ]
      )

instance Data.ToJSON RemoveCustomRoutingEndpoints where
  toJSON :: RemoveCustomRoutingEndpoints -> Value
toJSON RemoveCustomRoutingEndpoints' {[Text]
Text
endpointGroupArn :: Text
endpointIds :: [Text]
$sel:endpointGroupArn:RemoveCustomRoutingEndpoints' :: RemoveCustomRoutingEndpoints -> Text
$sel:endpointIds:RemoveCustomRoutingEndpoints' :: RemoveCustomRoutingEndpoints -> [Text]
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ forall a. a -> Maybe a
Prelude.Just (Key
"EndpointIds" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= [Text]
endpointIds),
            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 RemoveCustomRoutingEndpoints where
  toPath :: RemoveCustomRoutingEndpoints -> ByteString
toPath = forall a b. a -> b -> a
Prelude.const ByteString
"/"

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

-- | /See:/ 'newRemoveCustomRoutingEndpointsResponse' smart constructor.
data RemoveCustomRoutingEndpointsResponse = RemoveCustomRoutingEndpointsResponse'
  {
  }
  deriving (RemoveCustomRoutingEndpointsResponse
-> RemoveCustomRoutingEndpointsResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RemoveCustomRoutingEndpointsResponse
-> RemoveCustomRoutingEndpointsResponse -> Bool
$c/= :: RemoveCustomRoutingEndpointsResponse
-> RemoveCustomRoutingEndpointsResponse -> Bool
== :: RemoveCustomRoutingEndpointsResponse
-> RemoveCustomRoutingEndpointsResponse -> Bool
$c== :: RemoveCustomRoutingEndpointsResponse
-> RemoveCustomRoutingEndpointsResponse -> Bool
Prelude.Eq, ReadPrec [RemoveCustomRoutingEndpointsResponse]
ReadPrec RemoveCustomRoutingEndpointsResponse
Int -> ReadS RemoveCustomRoutingEndpointsResponse
ReadS [RemoveCustomRoutingEndpointsResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [RemoveCustomRoutingEndpointsResponse]
$creadListPrec :: ReadPrec [RemoveCustomRoutingEndpointsResponse]
readPrec :: ReadPrec RemoveCustomRoutingEndpointsResponse
$creadPrec :: ReadPrec RemoveCustomRoutingEndpointsResponse
readList :: ReadS [RemoveCustomRoutingEndpointsResponse]
$creadList :: ReadS [RemoveCustomRoutingEndpointsResponse]
readsPrec :: Int -> ReadS RemoveCustomRoutingEndpointsResponse
$creadsPrec :: Int -> ReadS RemoveCustomRoutingEndpointsResponse
Prelude.Read, Int -> RemoveCustomRoutingEndpointsResponse -> ShowS
[RemoveCustomRoutingEndpointsResponse] -> ShowS
RemoveCustomRoutingEndpointsResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RemoveCustomRoutingEndpointsResponse] -> ShowS
$cshowList :: [RemoveCustomRoutingEndpointsResponse] -> ShowS
show :: RemoveCustomRoutingEndpointsResponse -> String
$cshow :: RemoveCustomRoutingEndpointsResponse -> String
showsPrec :: Int -> RemoveCustomRoutingEndpointsResponse -> ShowS
$cshowsPrec :: Int -> RemoveCustomRoutingEndpointsResponse -> ShowS
Prelude.Show, forall x.
Rep RemoveCustomRoutingEndpointsResponse x
-> RemoveCustomRoutingEndpointsResponse
forall x.
RemoveCustomRoutingEndpointsResponse
-> Rep RemoveCustomRoutingEndpointsResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep RemoveCustomRoutingEndpointsResponse x
-> RemoveCustomRoutingEndpointsResponse
$cfrom :: forall x.
RemoveCustomRoutingEndpointsResponse
-> Rep RemoveCustomRoutingEndpointsResponse x
Prelude.Generic)

-- |
-- Create a value of 'RemoveCustomRoutingEndpointsResponse' 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.
newRemoveCustomRoutingEndpointsResponse ::
  RemoveCustomRoutingEndpointsResponse
newRemoveCustomRoutingEndpointsResponse :: RemoveCustomRoutingEndpointsResponse
newRemoveCustomRoutingEndpointsResponse =
  RemoveCustomRoutingEndpointsResponse
RemoveCustomRoutingEndpointsResponse'

instance
  Prelude.NFData
    RemoveCustomRoutingEndpointsResponse
  where
  rnf :: RemoveCustomRoutingEndpointsResponse -> ()
rnf RemoveCustomRoutingEndpointsResponse
_ = ()