{-# 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.DenyCustomRoutingTraffic
-- 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 cannot receive traffic for a custom routing
-- accelerator. You can deny traffic to all destinations in the VPC
-- endpoint, or deny traffic to a specified list of destination IP
-- addresses and ports. 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.DenyCustomRoutingTraffic
  ( -- * Creating a Request
    DenyCustomRoutingTraffic (..),
    newDenyCustomRoutingTraffic,

    -- * Request Lenses
    denyCustomRoutingTraffic_denyAllTrafficToEndpoint,
    denyCustomRoutingTraffic_destinationAddresses,
    denyCustomRoutingTraffic_destinationPorts,
    denyCustomRoutingTraffic_endpointGroupArn,
    denyCustomRoutingTraffic_endpointId,

    -- * Destructuring the Response
    DenyCustomRoutingTrafficResponse (..),
    newDenyCustomRoutingTrafficResponse,
  )
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:/ 'newDenyCustomRoutingTraffic' smart constructor.
data DenyCustomRoutingTraffic = DenyCustomRoutingTraffic'
  { -- | Indicates whether all destination IP addresses and ports for a specified
    -- VPC subnet endpoint /cannot/ receive traffic from a custom routing
    -- accelerator. The value is TRUE or FALSE.
    --
    -- When set to TRUE, /no/ 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 cannot 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.
    DenyCustomRoutingTraffic -> Maybe Bool
denyAllTrafficToEndpoint :: Prelude.Maybe Prelude.Bool,
    -- | A list of specific Amazon EC2 instance IP addresses (destination
    -- addresses) in a subnet that you want to prevent from receiving traffic.
    -- The IP addresses must be a subset of the IP addresses allowed for the
    -- VPC subnet associated with the endpoint group.
    DenyCustomRoutingTraffic -> Maybe [Text]
destinationAddresses :: Prelude.Maybe [Prelude.Text],
    -- | A list of specific Amazon EC2 instance ports (destination ports) in a
    -- subnet endpoint that you want to prevent from receiving traffic.
    DenyCustomRoutingTraffic -> Maybe [Natural]
destinationPorts :: Prelude.Maybe [Prelude.Natural],
    -- | The Amazon Resource Name (ARN) of the endpoint group.
    DenyCustomRoutingTraffic -> Text
endpointGroupArn :: Prelude.Text,
    -- | An ID for the endpoint. For custom routing accelerators, this is the
    -- virtual private cloud (VPC) subnet ID.
    DenyCustomRoutingTraffic -> Text
endpointId :: Prelude.Text
  }
  deriving (DenyCustomRoutingTraffic -> DenyCustomRoutingTraffic -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DenyCustomRoutingTraffic -> DenyCustomRoutingTraffic -> Bool
$c/= :: DenyCustomRoutingTraffic -> DenyCustomRoutingTraffic -> Bool
== :: DenyCustomRoutingTraffic -> DenyCustomRoutingTraffic -> Bool
$c== :: DenyCustomRoutingTraffic -> DenyCustomRoutingTraffic -> Bool
Prelude.Eq, ReadPrec [DenyCustomRoutingTraffic]
ReadPrec DenyCustomRoutingTraffic
Int -> ReadS DenyCustomRoutingTraffic
ReadS [DenyCustomRoutingTraffic]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DenyCustomRoutingTraffic]
$creadListPrec :: ReadPrec [DenyCustomRoutingTraffic]
readPrec :: ReadPrec DenyCustomRoutingTraffic
$creadPrec :: ReadPrec DenyCustomRoutingTraffic
readList :: ReadS [DenyCustomRoutingTraffic]
$creadList :: ReadS [DenyCustomRoutingTraffic]
readsPrec :: Int -> ReadS DenyCustomRoutingTraffic
$creadsPrec :: Int -> ReadS DenyCustomRoutingTraffic
Prelude.Read, Int -> DenyCustomRoutingTraffic -> ShowS
[DenyCustomRoutingTraffic] -> ShowS
DenyCustomRoutingTraffic -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DenyCustomRoutingTraffic] -> ShowS
$cshowList :: [DenyCustomRoutingTraffic] -> ShowS
show :: DenyCustomRoutingTraffic -> String
$cshow :: DenyCustomRoutingTraffic -> String
showsPrec :: Int -> DenyCustomRoutingTraffic -> ShowS
$cshowsPrec :: Int -> DenyCustomRoutingTraffic -> ShowS
Prelude.Show, forall x.
Rep DenyCustomRoutingTraffic x -> DenyCustomRoutingTraffic
forall x.
DenyCustomRoutingTraffic -> Rep DenyCustomRoutingTraffic x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep DenyCustomRoutingTraffic x -> DenyCustomRoutingTraffic
$cfrom :: forall x.
DenyCustomRoutingTraffic -> Rep DenyCustomRoutingTraffic x
Prelude.Generic)

-- |
-- Create a value of 'DenyCustomRoutingTraffic' 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:
--
-- 'denyAllTrafficToEndpoint', 'denyCustomRoutingTraffic_denyAllTrafficToEndpoint' - Indicates whether all destination IP addresses and ports for a specified
-- VPC subnet endpoint /cannot/ receive traffic from a custom routing
-- accelerator. The value is TRUE or FALSE.
--
-- When set to TRUE, /no/ 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 cannot 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', 'denyCustomRoutingTraffic_destinationAddresses' - A list of specific Amazon EC2 instance IP addresses (destination
-- addresses) in a subnet that you want to prevent from receiving traffic.
-- The IP addresses must be a subset of the IP addresses allowed for the
-- VPC subnet associated with the endpoint group.
--
-- 'destinationPorts', 'denyCustomRoutingTraffic_destinationPorts' - A list of specific Amazon EC2 instance ports (destination ports) in a
-- subnet endpoint that you want to prevent from receiving traffic.
--
-- 'endpointGroupArn', 'denyCustomRoutingTraffic_endpointGroupArn' - The Amazon Resource Name (ARN) of the endpoint group.
--
-- 'endpointId', 'denyCustomRoutingTraffic_endpointId' - An ID for the endpoint. For custom routing accelerators, this is the
-- virtual private cloud (VPC) subnet ID.
newDenyCustomRoutingTraffic ::
  -- | 'endpointGroupArn'
  Prelude.Text ->
  -- | 'endpointId'
  Prelude.Text ->
  DenyCustomRoutingTraffic
newDenyCustomRoutingTraffic :: Text -> Text -> DenyCustomRoutingTraffic
newDenyCustomRoutingTraffic
  Text
pEndpointGroupArn_
  Text
pEndpointId_ =
    DenyCustomRoutingTraffic'
      { $sel:denyAllTrafficToEndpoint:DenyCustomRoutingTraffic' :: Maybe Bool
denyAllTrafficToEndpoint =
          forall a. Maybe a
Prelude.Nothing,
        $sel:destinationAddresses:DenyCustomRoutingTraffic' :: Maybe [Text]
destinationAddresses = forall a. Maybe a
Prelude.Nothing,
        $sel:destinationPorts:DenyCustomRoutingTraffic' :: Maybe [Natural]
destinationPorts = forall a. Maybe a
Prelude.Nothing,
        $sel:endpointGroupArn:DenyCustomRoutingTraffic' :: Text
endpointGroupArn = Text
pEndpointGroupArn_,
        $sel:endpointId:DenyCustomRoutingTraffic' :: Text
endpointId = Text
pEndpointId_
      }

-- | Indicates whether all destination IP addresses and ports for a specified
-- VPC subnet endpoint /cannot/ receive traffic from a custom routing
-- accelerator. The value is TRUE or FALSE.
--
-- When set to TRUE, /no/ 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 cannot 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.
denyCustomRoutingTraffic_denyAllTrafficToEndpoint :: Lens.Lens' DenyCustomRoutingTraffic (Prelude.Maybe Prelude.Bool)
denyCustomRoutingTraffic_denyAllTrafficToEndpoint :: Lens' DenyCustomRoutingTraffic (Maybe Bool)
denyCustomRoutingTraffic_denyAllTrafficToEndpoint = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DenyCustomRoutingTraffic' {Maybe Bool
denyAllTrafficToEndpoint :: Maybe Bool
$sel:denyAllTrafficToEndpoint:DenyCustomRoutingTraffic' :: DenyCustomRoutingTraffic -> Maybe Bool
denyAllTrafficToEndpoint} -> Maybe Bool
denyAllTrafficToEndpoint) (\s :: DenyCustomRoutingTraffic
s@DenyCustomRoutingTraffic' {} Maybe Bool
a -> DenyCustomRoutingTraffic
s {$sel:denyAllTrafficToEndpoint:DenyCustomRoutingTraffic' :: Maybe Bool
denyAllTrafficToEndpoint = Maybe Bool
a} :: DenyCustomRoutingTraffic)

-- | A list of specific Amazon EC2 instance IP addresses (destination
-- addresses) in a subnet that you want to prevent from receiving traffic.
-- The IP addresses must be a subset of the IP addresses allowed for the
-- VPC subnet associated with the endpoint group.
denyCustomRoutingTraffic_destinationAddresses :: Lens.Lens' DenyCustomRoutingTraffic (Prelude.Maybe [Prelude.Text])
denyCustomRoutingTraffic_destinationAddresses :: Lens' DenyCustomRoutingTraffic (Maybe [Text])
denyCustomRoutingTraffic_destinationAddresses = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DenyCustomRoutingTraffic' {Maybe [Text]
destinationAddresses :: Maybe [Text]
$sel:destinationAddresses:DenyCustomRoutingTraffic' :: DenyCustomRoutingTraffic -> Maybe [Text]
destinationAddresses} -> Maybe [Text]
destinationAddresses) (\s :: DenyCustomRoutingTraffic
s@DenyCustomRoutingTraffic' {} Maybe [Text]
a -> DenyCustomRoutingTraffic
s {$sel:destinationAddresses:DenyCustomRoutingTraffic' :: Maybe [Text]
destinationAddresses = Maybe [Text]
a} :: DenyCustomRoutingTraffic) 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) in a
-- subnet endpoint that you want to prevent from receiving traffic.
denyCustomRoutingTraffic_destinationPorts :: Lens.Lens' DenyCustomRoutingTraffic (Prelude.Maybe [Prelude.Natural])
denyCustomRoutingTraffic_destinationPorts :: Lens' DenyCustomRoutingTraffic (Maybe [Natural])
denyCustomRoutingTraffic_destinationPorts = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DenyCustomRoutingTraffic' {Maybe [Natural]
destinationPorts :: Maybe [Natural]
$sel:destinationPorts:DenyCustomRoutingTraffic' :: DenyCustomRoutingTraffic -> Maybe [Natural]
destinationPorts} -> Maybe [Natural]
destinationPorts) (\s :: DenyCustomRoutingTraffic
s@DenyCustomRoutingTraffic' {} Maybe [Natural]
a -> DenyCustomRoutingTraffic
s {$sel:destinationPorts:DenyCustomRoutingTraffic' :: Maybe [Natural]
destinationPorts = Maybe [Natural]
a} :: DenyCustomRoutingTraffic) 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.
denyCustomRoutingTraffic_endpointGroupArn :: Lens.Lens' DenyCustomRoutingTraffic Prelude.Text
denyCustomRoutingTraffic_endpointGroupArn :: Lens' DenyCustomRoutingTraffic Text
denyCustomRoutingTraffic_endpointGroupArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DenyCustomRoutingTraffic' {Text
endpointGroupArn :: Text
$sel:endpointGroupArn:DenyCustomRoutingTraffic' :: DenyCustomRoutingTraffic -> Text
endpointGroupArn} -> Text
endpointGroupArn) (\s :: DenyCustomRoutingTraffic
s@DenyCustomRoutingTraffic' {} Text
a -> DenyCustomRoutingTraffic
s {$sel:endpointGroupArn:DenyCustomRoutingTraffic' :: Text
endpointGroupArn = Text
a} :: DenyCustomRoutingTraffic)

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

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

instance Prelude.Hashable DenyCustomRoutingTraffic where
  hashWithSalt :: Int -> DenyCustomRoutingTraffic -> Int
hashWithSalt Int
_salt DenyCustomRoutingTraffic' {Maybe Bool
Maybe [Natural]
Maybe [Text]
Text
endpointId :: Text
endpointGroupArn :: Text
destinationPorts :: Maybe [Natural]
destinationAddresses :: Maybe [Text]
denyAllTrafficToEndpoint :: Maybe Bool
$sel:endpointId:DenyCustomRoutingTraffic' :: DenyCustomRoutingTraffic -> Text
$sel:endpointGroupArn:DenyCustomRoutingTraffic' :: DenyCustomRoutingTraffic -> Text
$sel:destinationPorts:DenyCustomRoutingTraffic' :: DenyCustomRoutingTraffic -> Maybe [Natural]
$sel:destinationAddresses:DenyCustomRoutingTraffic' :: DenyCustomRoutingTraffic -> Maybe [Text]
$sel:denyAllTrafficToEndpoint:DenyCustomRoutingTraffic' :: DenyCustomRoutingTraffic -> Maybe Bool
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Bool
denyAllTrafficToEndpoint
      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 DenyCustomRoutingTraffic where
  rnf :: DenyCustomRoutingTraffic -> ()
rnf DenyCustomRoutingTraffic' {Maybe Bool
Maybe [Natural]
Maybe [Text]
Text
endpointId :: Text
endpointGroupArn :: Text
destinationPorts :: Maybe [Natural]
destinationAddresses :: Maybe [Text]
denyAllTrafficToEndpoint :: Maybe Bool
$sel:endpointId:DenyCustomRoutingTraffic' :: DenyCustomRoutingTraffic -> Text
$sel:endpointGroupArn:DenyCustomRoutingTraffic' :: DenyCustomRoutingTraffic -> Text
$sel:destinationPorts:DenyCustomRoutingTraffic' :: DenyCustomRoutingTraffic -> Maybe [Natural]
$sel:destinationAddresses:DenyCustomRoutingTraffic' :: DenyCustomRoutingTraffic -> Maybe [Text]
$sel:denyAllTrafficToEndpoint:DenyCustomRoutingTraffic' :: DenyCustomRoutingTraffic -> Maybe Bool
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Bool
denyAllTrafficToEndpoint
      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 DenyCustomRoutingTraffic where
  toHeaders :: DenyCustomRoutingTraffic -> [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.DenyCustomRoutingTraffic" ::
                          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 DenyCustomRoutingTraffic where
  toJSON :: DenyCustomRoutingTraffic -> Value
toJSON DenyCustomRoutingTraffic' {Maybe Bool
Maybe [Natural]
Maybe [Text]
Text
endpointId :: Text
endpointGroupArn :: Text
destinationPorts :: Maybe [Natural]
destinationAddresses :: Maybe [Text]
denyAllTrafficToEndpoint :: Maybe Bool
$sel:endpointId:DenyCustomRoutingTraffic' :: DenyCustomRoutingTraffic -> Text
$sel:endpointGroupArn:DenyCustomRoutingTraffic' :: DenyCustomRoutingTraffic -> Text
$sel:destinationPorts:DenyCustomRoutingTraffic' :: DenyCustomRoutingTraffic -> Maybe [Natural]
$sel:destinationAddresses:DenyCustomRoutingTraffic' :: DenyCustomRoutingTraffic -> Maybe [Text]
$sel:denyAllTrafficToEndpoint:DenyCustomRoutingTraffic' :: DenyCustomRoutingTraffic -> Maybe Bool
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"DenyAllTrafficToEndpoint" 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
denyAllTrafficToEndpoint,
            (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 DenyCustomRoutingTraffic where
  toPath :: DenyCustomRoutingTraffic -> ByteString
toPath = forall a b. a -> b -> a
Prelude.const ByteString
"/"

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

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

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

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