{-# 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.AllowCustomRoutingTraffic
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Specify the Amazon EC2 instance (destination) IP addresses and ports for
-- a VPC subnet endpoint that can receive traffic for a custom routing
-- accelerator. You can allow traffic to all destinations in the subnet
-- endpoint, or allow traffic to a specified list of destination IP
-- addresses and ports in the subnet. Note that you cannot specify IP
-- addresses or ports outside of the range that you configured for the
-- endpoint group.
--
-- After you make changes, you can verify that the updates are complete by
-- checking the status of your accelerator: the status changes from
-- IN_PROGRESS to DEPLOYED.
module Amazonka.GlobalAccelerator.AllowCustomRoutingTraffic
  ( -- * Creating a Request
    AllowCustomRoutingTraffic (..),
    newAllowCustomRoutingTraffic,

    -- * Request Lenses
    allowCustomRoutingTraffic_allowAllTrafficToEndpoint,
    allowCustomRoutingTraffic_destinationAddresses,
    allowCustomRoutingTraffic_destinationPorts,
    allowCustomRoutingTraffic_endpointGroupArn,
    allowCustomRoutingTraffic_endpointId,

    -- * Destructuring the Response
    AllowCustomRoutingTrafficResponse (..),
    newAllowCustomRoutingTrafficResponse,
  )
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:/ 'newAllowCustomRoutingTraffic' smart constructor.
data AllowCustomRoutingTraffic = AllowCustomRoutingTraffic'
  { -- | Indicates whether all destination IP addresses and ports for a specified
    -- VPC subnet endpoint can receive traffic from a custom routing
    -- accelerator. The value is TRUE or FALSE.
    --
    -- When set to TRUE, /all/ destinations in the custom routing VPC subnet
    -- can receive traffic. Note that you cannot specify destination IP
    -- addresses and ports when the value is set to TRUE.
    --
    -- When set to FALSE (or not specified), you /must/ specify a list of
    -- destination IP addresses that are allowed to receive traffic. A list of
    -- ports is optional. If you don\'t specify a list of ports, the ports that
    -- can accept traffic is the same as the ports configured for the endpoint
    -- group.
    --
    -- The default value is FALSE.
    AllowCustomRoutingTraffic -> Maybe Bool
allowAllTrafficToEndpoint :: Prelude.Maybe Prelude.Bool,
    -- | A list of specific Amazon EC2 instance IP addresses (destination
    -- addresses) in a subnet that you want to allow to receive traffic. The IP
    -- addresses must be a subset of the IP addresses that you specified for
    -- the endpoint group.
    --
    -- @DestinationAddresses@ is required if @AllowAllTrafficToEndpoint@ is
    -- @FALSE@ or is not specified.
    AllowCustomRoutingTraffic -> Maybe [Text]
destinationAddresses :: Prelude.Maybe [Prelude.Text],
    -- | A list of specific Amazon EC2 instance ports (destination ports) that
    -- you want to allow to receive traffic.
    AllowCustomRoutingTraffic -> Maybe [Natural]
destinationPorts :: Prelude.Maybe [Prelude.Natural],
    -- | The Amazon Resource Name (ARN) of the endpoint group.
    AllowCustomRoutingTraffic -> Text
endpointGroupArn :: Prelude.Text,
    -- | An ID for the endpoint. For custom routing accelerators, this is the
    -- virtual private cloud (VPC) subnet ID.
    AllowCustomRoutingTraffic -> Text
endpointId :: Prelude.Text
  }
  deriving (AllowCustomRoutingTraffic -> AllowCustomRoutingTraffic -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AllowCustomRoutingTraffic -> AllowCustomRoutingTraffic -> Bool
$c/= :: AllowCustomRoutingTraffic -> AllowCustomRoutingTraffic -> Bool
== :: AllowCustomRoutingTraffic -> AllowCustomRoutingTraffic -> Bool
$c== :: AllowCustomRoutingTraffic -> AllowCustomRoutingTraffic -> Bool
Prelude.Eq, ReadPrec [AllowCustomRoutingTraffic]
ReadPrec AllowCustomRoutingTraffic
Int -> ReadS AllowCustomRoutingTraffic
ReadS [AllowCustomRoutingTraffic]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [AllowCustomRoutingTraffic]
$creadListPrec :: ReadPrec [AllowCustomRoutingTraffic]
readPrec :: ReadPrec AllowCustomRoutingTraffic
$creadPrec :: ReadPrec AllowCustomRoutingTraffic
readList :: ReadS [AllowCustomRoutingTraffic]
$creadList :: ReadS [AllowCustomRoutingTraffic]
readsPrec :: Int -> ReadS AllowCustomRoutingTraffic
$creadsPrec :: Int -> ReadS AllowCustomRoutingTraffic
Prelude.Read, Int -> AllowCustomRoutingTraffic -> ShowS
[AllowCustomRoutingTraffic] -> ShowS
AllowCustomRoutingTraffic -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AllowCustomRoutingTraffic] -> ShowS
$cshowList :: [AllowCustomRoutingTraffic] -> ShowS
show :: AllowCustomRoutingTraffic -> String
$cshow :: AllowCustomRoutingTraffic -> String
showsPrec :: Int -> AllowCustomRoutingTraffic -> ShowS
$cshowsPrec :: Int -> AllowCustomRoutingTraffic -> ShowS
Prelude.Show, forall x.
Rep AllowCustomRoutingTraffic x -> AllowCustomRoutingTraffic
forall x.
AllowCustomRoutingTraffic -> Rep AllowCustomRoutingTraffic x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep AllowCustomRoutingTraffic x -> AllowCustomRoutingTraffic
$cfrom :: forall x.
AllowCustomRoutingTraffic -> Rep AllowCustomRoutingTraffic x
Prelude.Generic)

-- |
-- Create a value of 'AllowCustomRoutingTraffic' 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:
--
-- 'allowAllTrafficToEndpoint', 'allowCustomRoutingTraffic_allowAllTrafficToEndpoint' - Indicates whether all destination IP addresses and ports for a specified
-- VPC subnet endpoint can receive traffic from a custom routing
-- accelerator. The value is TRUE or FALSE.
--
-- When set to TRUE, /all/ destinations in the custom routing VPC subnet
-- can receive traffic. Note that you cannot specify destination IP
-- addresses and ports when the value is set to TRUE.
--
-- When set to FALSE (or not specified), you /must/ specify a list of
-- destination IP addresses that are allowed to receive traffic. A list of
-- ports is optional. If you don\'t specify a list of ports, the ports that
-- can accept traffic is the same as the ports configured for the endpoint
-- group.
--
-- The default value is FALSE.
--
-- 'destinationAddresses', 'allowCustomRoutingTraffic_destinationAddresses' - A list of specific Amazon EC2 instance IP addresses (destination
-- addresses) in a subnet that you want to allow to receive traffic. The IP
-- addresses must be a subset of the IP addresses that you specified for
-- the endpoint group.
--
-- @DestinationAddresses@ is required if @AllowAllTrafficToEndpoint@ is
-- @FALSE@ or is not specified.
--
-- 'destinationPorts', 'allowCustomRoutingTraffic_destinationPorts' - A list of specific Amazon EC2 instance ports (destination ports) that
-- you want to allow to receive traffic.
--
-- 'endpointGroupArn', 'allowCustomRoutingTraffic_endpointGroupArn' - The Amazon Resource Name (ARN) of the endpoint group.
--
-- 'endpointId', 'allowCustomRoutingTraffic_endpointId' - An ID for the endpoint. For custom routing accelerators, this is the
-- virtual private cloud (VPC) subnet ID.
newAllowCustomRoutingTraffic ::
  -- | 'endpointGroupArn'
  Prelude.Text ->
  -- | 'endpointId'
  Prelude.Text ->
  AllowCustomRoutingTraffic
newAllowCustomRoutingTraffic :: Text -> Text -> AllowCustomRoutingTraffic
newAllowCustomRoutingTraffic
  Text
pEndpointGroupArn_
  Text
pEndpointId_ =
    AllowCustomRoutingTraffic'
      { $sel:allowAllTrafficToEndpoint:AllowCustomRoutingTraffic' :: Maybe Bool
allowAllTrafficToEndpoint =
          forall a. Maybe a
Prelude.Nothing,
        $sel:destinationAddresses:AllowCustomRoutingTraffic' :: Maybe [Text]
destinationAddresses = forall a. Maybe a
Prelude.Nothing,
        $sel:destinationPorts:AllowCustomRoutingTraffic' :: Maybe [Natural]
destinationPorts = forall a. Maybe a
Prelude.Nothing,
        $sel:endpointGroupArn:AllowCustomRoutingTraffic' :: Text
endpointGroupArn = Text
pEndpointGroupArn_,
        $sel:endpointId:AllowCustomRoutingTraffic' :: Text
endpointId = Text
pEndpointId_
      }

-- | Indicates whether all destination IP addresses and ports for a specified
-- VPC subnet endpoint can receive traffic from a custom routing
-- accelerator. The value is TRUE or FALSE.
--
-- When set to TRUE, /all/ destinations in the custom routing VPC subnet
-- can receive traffic. Note that you cannot specify destination IP
-- addresses and ports when the value is set to TRUE.
--
-- When set to FALSE (or not specified), you /must/ specify a list of
-- destination IP addresses that are allowed to receive traffic. A list of
-- ports is optional. If you don\'t specify a list of ports, the ports that
-- can accept traffic is the same as the ports configured for the endpoint
-- group.
--
-- The default value is FALSE.
allowCustomRoutingTraffic_allowAllTrafficToEndpoint :: Lens.Lens' AllowCustomRoutingTraffic (Prelude.Maybe Prelude.Bool)
allowCustomRoutingTraffic_allowAllTrafficToEndpoint :: Lens' AllowCustomRoutingTraffic (Maybe Bool)
allowCustomRoutingTraffic_allowAllTrafficToEndpoint = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\AllowCustomRoutingTraffic' {Maybe Bool
allowAllTrafficToEndpoint :: Maybe Bool
$sel:allowAllTrafficToEndpoint:AllowCustomRoutingTraffic' :: AllowCustomRoutingTraffic -> Maybe Bool
allowAllTrafficToEndpoint} -> Maybe Bool
allowAllTrafficToEndpoint) (\s :: AllowCustomRoutingTraffic
s@AllowCustomRoutingTraffic' {} Maybe Bool
a -> AllowCustomRoutingTraffic
s {$sel:allowAllTrafficToEndpoint:AllowCustomRoutingTraffic' :: Maybe Bool
allowAllTrafficToEndpoint = Maybe Bool
a} :: AllowCustomRoutingTraffic)

-- | A list of specific Amazon EC2 instance IP addresses (destination
-- addresses) in a subnet that you want to allow to receive traffic. The IP
-- addresses must be a subset of the IP addresses that you specified for
-- the endpoint group.
--
-- @DestinationAddresses@ is required if @AllowAllTrafficToEndpoint@ is
-- @FALSE@ or is not specified.
allowCustomRoutingTraffic_destinationAddresses :: Lens.Lens' AllowCustomRoutingTraffic (Prelude.Maybe [Prelude.Text])
allowCustomRoutingTraffic_destinationAddresses :: Lens' AllowCustomRoutingTraffic (Maybe [Text])
allowCustomRoutingTraffic_destinationAddresses = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\AllowCustomRoutingTraffic' {Maybe [Text]
destinationAddresses :: Maybe [Text]
$sel:destinationAddresses:AllowCustomRoutingTraffic' :: AllowCustomRoutingTraffic -> Maybe [Text]
destinationAddresses} -> Maybe [Text]
destinationAddresses) (\s :: AllowCustomRoutingTraffic
s@AllowCustomRoutingTraffic' {} Maybe [Text]
a -> AllowCustomRoutingTraffic
s {$sel:destinationAddresses:AllowCustomRoutingTraffic' :: Maybe [Text]
destinationAddresses = Maybe [Text]
a} :: AllowCustomRoutingTraffic) 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

-- | A list of specific Amazon EC2 instance ports (destination ports) that
-- you want to allow to receive traffic.
allowCustomRoutingTraffic_destinationPorts :: Lens.Lens' AllowCustomRoutingTraffic (Prelude.Maybe [Prelude.Natural])
allowCustomRoutingTraffic_destinationPorts :: Lens' AllowCustomRoutingTraffic (Maybe [Natural])
allowCustomRoutingTraffic_destinationPorts = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\AllowCustomRoutingTraffic' {Maybe [Natural]
destinationPorts :: Maybe [Natural]
$sel:destinationPorts:AllowCustomRoutingTraffic' :: AllowCustomRoutingTraffic -> Maybe [Natural]
destinationPorts} -> Maybe [Natural]
destinationPorts) (\s :: AllowCustomRoutingTraffic
s@AllowCustomRoutingTraffic' {} Maybe [Natural]
a -> AllowCustomRoutingTraffic
s {$sel:destinationPorts:AllowCustomRoutingTraffic' :: Maybe [Natural]
destinationPorts = Maybe [Natural]
a} :: AllowCustomRoutingTraffic) 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.
allowCustomRoutingTraffic_endpointGroupArn :: Lens.Lens' AllowCustomRoutingTraffic Prelude.Text
allowCustomRoutingTraffic_endpointGroupArn :: Lens' AllowCustomRoutingTraffic Text
allowCustomRoutingTraffic_endpointGroupArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\AllowCustomRoutingTraffic' {Text
endpointGroupArn :: Text
$sel:endpointGroupArn:AllowCustomRoutingTraffic' :: AllowCustomRoutingTraffic -> Text
endpointGroupArn} -> Text
endpointGroupArn) (\s :: AllowCustomRoutingTraffic
s@AllowCustomRoutingTraffic' {} Text
a -> AllowCustomRoutingTraffic
s {$sel:endpointGroupArn:AllowCustomRoutingTraffic' :: Text
endpointGroupArn = Text
a} :: AllowCustomRoutingTraffic)

-- | An ID for the endpoint. For custom routing accelerators, this is the
-- virtual private cloud (VPC) subnet ID.
allowCustomRoutingTraffic_endpointId :: Lens.Lens' AllowCustomRoutingTraffic Prelude.Text
allowCustomRoutingTraffic_endpointId :: Lens' AllowCustomRoutingTraffic Text
allowCustomRoutingTraffic_endpointId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\AllowCustomRoutingTraffic' {Text
endpointId :: Text
$sel:endpointId:AllowCustomRoutingTraffic' :: AllowCustomRoutingTraffic -> Text
endpointId} -> Text
endpointId) (\s :: AllowCustomRoutingTraffic
s@AllowCustomRoutingTraffic' {} Text
a -> AllowCustomRoutingTraffic
s {$sel:endpointId:AllowCustomRoutingTraffic' :: Text
endpointId = Text
a} :: AllowCustomRoutingTraffic)

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

instance Prelude.Hashable AllowCustomRoutingTraffic where
  hashWithSalt :: Int -> AllowCustomRoutingTraffic -> Int
hashWithSalt Int
_salt AllowCustomRoutingTraffic' {Maybe Bool
Maybe [Natural]
Maybe [Text]
Text
endpointId :: Text
endpointGroupArn :: Text
destinationPorts :: Maybe [Natural]
destinationAddresses :: Maybe [Text]
allowAllTrafficToEndpoint :: Maybe Bool
$sel:endpointId:AllowCustomRoutingTraffic' :: AllowCustomRoutingTraffic -> Text
$sel:endpointGroupArn:AllowCustomRoutingTraffic' :: AllowCustomRoutingTraffic -> Text
$sel:destinationPorts:AllowCustomRoutingTraffic' :: AllowCustomRoutingTraffic -> Maybe [Natural]
$sel:destinationAddresses:AllowCustomRoutingTraffic' :: AllowCustomRoutingTraffic -> Maybe [Text]
$sel:allowAllTrafficToEndpoint:AllowCustomRoutingTraffic' :: AllowCustomRoutingTraffic -> Maybe Bool
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Bool
allowAllTrafficToEndpoint
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [Text]
destinationAddresses
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [Natural]
destinationPorts
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
endpointGroupArn
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
endpointId

instance Prelude.NFData AllowCustomRoutingTraffic where
  rnf :: AllowCustomRoutingTraffic -> ()
rnf AllowCustomRoutingTraffic' {Maybe Bool
Maybe [Natural]
Maybe [Text]
Text
endpointId :: Text
endpointGroupArn :: Text
destinationPorts :: Maybe [Natural]
destinationAddresses :: Maybe [Text]
allowAllTrafficToEndpoint :: Maybe Bool
$sel:endpointId:AllowCustomRoutingTraffic' :: AllowCustomRoutingTraffic -> Text
$sel:endpointGroupArn:AllowCustomRoutingTraffic' :: AllowCustomRoutingTraffic -> Text
$sel:destinationPorts:AllowCustomRoutingTraffic' :: AllowCustomRoutingTraffic -> Maybe [Natural]
$sel:destinationAddresses:AllowCustomRoutingTraffic' :: AllowCustomRoutingTraffic -> Maybe [Text]
$sel:allowAllTrafficToEndpoint:AllowCustomRoutingTraffic' :: AllowCustomRoutingTraffic -> Maybe Bool
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Bool
allowAllTrafficToEndpoint
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [Text]
destinationAddresses
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [Natural]
destinationPorts
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
endpointGroupArn
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
endpointId

instance Data.ToHeaders AllowCustomRoutingTraffic where
  toHeaders :: AllowCustomRoutingTraffic -> [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.AllowCustomRoutingTraffic" ::
                          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 AllowCustomRoutingTraffic where
  toJSON :: AllowCustomRoutingTraffic -> Value
toJSON AllowCustomRoutingTraffic' {Maybe Bool
Maybe [Natural]
Maybe [Text]
Text
endpointId :: Text
endpointGroupArn :: Text
destinationPorts :: Maybe [Natural]
destinationAddresses :: Maybe [Text]
allowAllTrafficToEndpoint :: Maybe Bool
$sel:endpointId:AllowCustomRoutingTraffic' :: AllowCustomRoutingTraffic -> Text
$sel:endpointGroupArn:AllowCustomRoutingTraffic' :: AllowCustomRoutingTraffic -> Text
$sel:destinationPorts:AllowCustomRoutingTraffic' :: AllowCustomRoutingTraffic -> Maybe [Natural]
$sel:destinationAddresses:AllowCustomRoutingTraffic' :: AllowCustomRoutingTraffic -> Maybe [Text]
$sel:allowAllTrafficToEndpoint:AllowCustomRoutingTraffic' :: AllowCustomRoutingTraffic -> Maybe Bool
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"AllowAllTrafficToEndpoint" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=)
              forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe Bool
allowAllTrafficToEndpoint,
            (Key
"DestinationAddresses" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=)
              forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe [Text]
destinationAddresses,
            (Key
"DestinationPorts" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=)
              forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe [Natural]
destinationPorts,
            forall a. a -> Maybe a
Prelude.Just
              (Key
"EndpointGroupArn" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
endpointGroupArn),
            forall a. a -> Maybe a
Prelude.Just (Key
"EndpointId" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
endpointId)
          ]
      )

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

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

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

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

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