{-# 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.EC2.ReplaceNetworkAclEntry
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Replaces an entry (rule) in a network ACL. For more information, see
-- <https://docs.aws.amazon.com/vpc/latest/userguide/VPC_ACLs.html Network ACLs>
-- in the /Amazon Virtual Private Cloud User Guide/.
module Amazonka.EC2.ReplaceNetworkAclEntry
  ( -- * Creating a Request
    ReplaceNetworkAclEntry (..),
    newReplaceNetworkAclEntry,

    -- * Request Lenses
    replaceNetworkAclEntry_cidrBlock,
    replaceNetworkAclEntry_dryRun,
    replaceNetworkAclEntry_icmpTypeCode,
    replaceNetworkAclEntry_ipv6CidrBlock,
    replaceNetworkAclEntry_portRange,
    replaceNetworkAclEntry_egress,
    replaceNetworkAclEntry_networkAclId,
    replaceNetworkAclEntry_protocol,
    replaceNetworkAclEntry_ruleAction,
    replaceNetworkAclEntry_ruleNumber,

    -- * Destructuring the Response
    ReplaceNetworkAclEntryResponse (..),
    newReplaceNetworkAclEntryResponse,
  )
where

import qualified Amazonka.Core as Core
import qualified Amazonka.Core.Lens.Internal as Lens
import qualified Amazonka.Data as Data
import Amazonka.EC2.Types
import qualified Amazonka.Prelude as Prelude
import qualified Amazonka.Request as Request
import qualified Amazonka.Response as Response

-- | /See:/ 'newReplaceNetworkAclEntry' smart constructor.
data ReplaceNetworkAclEntry = ReplaceNetworkAclEntry'
  { -- | The IPv4 network range to allow or deny, in CIDR notation (for example
    -- @172.16.0.0\/24@).
    ReplaceNetworkAclEntry -> Maybe Text
cidrBlock :: Prelude.Maybe Prelude.Text,
    -- | Checks whether you have the required permissions for the action, without
    -- actually making the request, and provides an error response. If you have
    -- the required permissions, the error response is @DryRunOperation@.
    -- Otherwise, it is @UnauthorizedOperation@.
    ReplaceNetworkAclEntry -> Maybe Bool
dryRun :: Prelude.Maybe Prelude.Bool,
    -- | ICMP protocol: The ICMP or ICMPv6 type and code. Required if specifying
    -- protocol 1 (ICMP) or protocol 58 (ICMPv6) with an IPv6 CIDR block.
    ReplaceNetworkAclEntry -> Maybe IcmpTypeCode
icmpTypeCode :: Prelude.Maybe IcmpTypeCode,
    -- | The IPv6 network range to allow or deny, in CIDR notation (for example
    -- @2001:bd8:1234:1a00::\/64@).
    ReplaceNetworkAclEntry -> Maybe Text
ipv6CidrBlock :: Prelude.Maybe Prelude.Text,
    -- | TCP or UDP protocols: The range of ports the rule applies to. Required
    -- if specifying protocol 6 (TCP) or 17 (UDP).
    ReplaceNetworkAclEntry -> Maybe PortRange
portRange :: Prelude.Maybe PortRange,
    -- | Indicates whether to replace the egress rule.
    --
    -- Default: If no value is specified, we replace the ingress rule.
    ReplaceNetworkAclEntry -> Bool
egress :: Prelude.Bool,
    -- | The ID of the ACL.
    ReplaceNetworkAclEntry -> Text
networkAclId :: Prelude.Text,
    -- | The protocol number. A value of \"-1\" means all protocols. If you
    -- specify \"-1\" or a protocol number other than \"6\" (TCP), \"17\"
    -- (UDP), or \"1\" (ICMP), traffic on all ports is allowed, regardless of
    -- any ports or ICMP types or codes that you specify. If you specify
    -- protocol \"58\" (ICMPv6) and specify an IPv4 CIDR block, traffic for all
    -- ICMP types and codes allowed, regardless of any that you specify. If you
    -- specify protocol \"58\" (ICMPv6) and specify an IPv6 CIDR block, you
    -- must specify an ICMP type and code.
    ReplaceNetworkAclEntry -> Text
protocol :: Prelude.Text,
    -- | Indicates whether to allow or deny the traffic that matches the rule.
    ReplaceNetworkAclEntry -> RuleAction
ruleAction :: RuleAction,
    -- | The rule number of the entry to replace.
    ReplaceNetworkAclEntry -> Int
ruleNumber :: Prelude.Int
  }
  deriving (ReplaceNetworkAclEntry -> ReplaceNetworkAclEntry -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ReplaceNetworkAclEntry -> ReplaceNetworkAclEntry -> Bool
$c/= :: ReplaceNetworkAclEntry -> ReplaceNetworkAclEntry -> Bool
== :: ReplaceNetworkAclEntry -> ReplaceNetworkAclEntry -> Bool
$c== :: ReplaceNetworkAclEntry -> ReplaceNetworkAclEntry -> Bool
Prelude.Eq, ReadPrec [ReplaceNetworkAclEntry]
ReadPrec ReplaceNetworkAclEntry
Int -> ReadS ReplaceNetworkAclEntry
ReadS [ReplaceNetworkAclEntry]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ReplaceNetworkAclEntry]
$creadListPrec :: ReadPrec [ReplaceNetworkAclEntry]
readPrec :: ReadPrec ReplaceNetworkAclEntry
$creadPrec :: ReadPrec ReplaceNetworkAclEntry
readList :: ReadS [ReplaceNetworkAclEntry]
$creadList :: ReadS [ReplaceNetworkAclEntry]
readsPrec :: Int -> ReadS ReplaceNetworkAclEntry
$creadsPrec :: Int -> ReadS ReplaceNetworkAclEntry
Prelude.Read, Int -> ReplaceNetworkAclEntry -> ShowS
[ReplaceNetworkAclEntry] -> ShowS
ReplaceNetworkAclEntry -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ReplaceNetworkAclEntry] -> ShowS
$cshowList :: [ReplaceNetworkAclEntry] -> ShowS
show :: ReplaceNetworkAclEntry -> String
$cshow :: ReplaceNetworkAclEntry -> String
showsPrec :: Int -> ReplaceNetworkAclEntry -> ShowS
$cshowsPrec :: Int -> ReplaceNetworkAclEntry -> ShowS
Prelude.Show, forall x. Rep ReplaceNetworkAclEntry x -> ReplaceNetworkAclEntry
forall x. ReplaceNetworkAclEntry -> Rep ReplaceNetworkAclEntry x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ReplaceNetworkAclEntry x -> ReplaceNetworkAclEntry
$cfrom :: forall x. ReplaceNetworkAclEntry -> Rep ReplaceNetworkAclEntry x
Prelude.Generic)

-- |
-- Create a value of 'ReplaceNetworkAclEntry' 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:
--
-- 'cidrBlock', 'replaceNetworkAclEntry_cidrBlock' - The IPv4 network range to allow or deny, in CIDR notation (for example
-- @172.16.0.0\/24@).
--
-- 'dryRun', 'replaceNetworkAclEntry_dryRun' - Checks whether you have the required permissions for the action, without
-- actually making the request, and provides an error response. If you have
-- the required permissions, the error response is @DryRunOperation@.
-- Otherwise, it is @UnauthorizedOperation@.
--
-- 'icmpTypeCode', 'replaceNetworkAclEntry_icmpTypeCode' - ICMP protocol: The ICMP or ICMPv6 type and code. Required if specifying
-- protocol 1 (ICMP) or protocol 58 (ICMPv6) with an IPv6 CIDR block.
--
-- 'ipv6CidrBlock', 'replaceNetworkAclEntry_ipv6CidrBlock' - The IPv6 network range to allow or deny, in CIDR notation (for example
-- @2001:bd8:1234:1a00::\/64@).
--
-- 'portRange', 'replaceNetworkAclEntry_portRange' - TCP or UDP protocols: The range of ports the rule applies to. Required
-- if specifying protocol 6 (TCP) or 17 (UDP).
--
-- 'egress', 'replaceNetworkAclEntry_egress' - Indicates whether to replace the egress rule.
--
-- Default: If no value is specified, we replace the ingress rule.
--
-- 'networkAclId', 'replaceNetworkAclEntry_networkAclId' - The ID of the ACL.
--
-- 'protocol', 'replaceNetworkAclEntry_protocol' - The protocol number. A value of \"-1\" means all protocols. If you
-- specify \"-1\" or a protocol number other than \"6\" (TCP), \"17\"
-- (UDP), or \"1\" (ICMP), traffic on all ports is allowed, regardless of
-- any ports or ICMP types or codes that you specify. If you specify
-- protocol \"58\" (ICMPv6) and specify an IPv4 CIDR block, traffic for all
-- ICMP types and codes allowed, regardless of any that you specify. If you
-- specify protocol \"58\" (ICMPv6) and specify an IPv6 CIDR block, you
-- must specify an ICMP type and code.
--
-- 'ruleAction', 'replaceNetworkAclEntry_ruleAction' - Indicates whether to allow or deny the traffic that matches the rule.
--
-- 'ruleNumber', 'replaceNetworkAclEntry_ruleNumber' - The rule number of the entry to replace.
newReplaceNetworkAclEntry ::
  -- | 'egress'
  Prelude.Bool ->
  -- | 'networkAclId'
  Prelude.Text ->
  -- | 'protocol'
  Prelude.Text ->
  -- | 'ruleAction'
  RuleAction ->
  -- | 'ruleNumber'
  Prelude.Int ->
  ReplaceNetworkAclEntry
newReplaceNetworkAclEntry :: Bool -> Text -> Text -> RuleAction -> Int -> ReplaceNetworkAclEntry
newReplaceNetworkAclEntry
  Bool
pEgress_
  Text
pNetworkAclId_
  Text
pProtocol_
  RuleAction
pRuleAction_
  Int
pRuleNumber_ =
    ReplaceNetworkAclEntry'
      { $sel:cidrBlock:ReplaceNetworkAclEntry' :: Maybe Text
cidrBlock =
          forall a. Maybe a
Prelude.Nothing,
        $sel:dryRun:ReplaceNetworkAclEntry' :: Maybe Bool
dryRun = forall a. Maybe a
Prelude.Nothing,
        $sel:icmpTypeCode:ReplaceNetworkAclEntry' :: Maybe IcmpTypeCode
icmpTypeCode = forall a. Maybe a
Prelude.Nothing,
        $sel:ipv6CidrBlock:ReplaceNetworkAclEntry' :: Maybe Text
ipv6CidrBlock = forall a. Maybe a
Prelude.Nothing,
        $sel:portRange:ReplaceNetworkAclEntry' :: Maybe PortRange
portRange = forall a. Maybe a
Prelude.Nothing,
        $sel:egress:ReplaceNetworkAclEntry' :: Bool
egress = Bool
pEgress_,
        $sel:networkAclId:ReplaceNetworkAclEntry' :: Text
networkAclId = Text
pNetworkAclId_,
        $sel:protocol:ReplaceNetworkAclEntry' :: Text
protocol = Text
pProtocol_,
        $sel:ruleAction:ReplaceNetworkAclEntry' :: RuleAction
ruleAction = RuleAction
pRuleAction_,
        $sel:ruleNumber:ReplaceNetworkAclEntry' :: Int
ruleNumber = Int
pRuleNumber_
      }

-- | The IPv4 network range to allow or deny, in CIDR notation (for example
-- @172.16.0.0\/24@).
replaceNetworkAclEntry_cidrBlock :: Lens.Lens' ReplaceNetworkAclEntry (Prelude.Maybe Prelude.Text)
replaceNetworkAclEntry_cidrBlock :: Lens' ReplaceNetworkAclEntry (Maybe Text)
replaceNetworkAclEntry_cidrBlock = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ReplaceNetworkAclEntry' {Maybe Text
cidrBlock :: Maybe Text
$sel:cidrBlock:ReplaceNetworkAclEntry' :: ReplaceNetworkAclEntry -> Maybe Text
cidrBlock} -> Maybe Text
cidrBlock) (\s :: ReplaceNetworkAclEntry
s@ReplaceNetworkAclEntry' {} Maybe Text
a -> ReplaceNetworkAclEntry
s {$sel:cidrBlock:ReplaceNetworkAclEntry' :: Maybe Text
cidrBlock = Maybe Text
a} :: ReplaceNetworkAclEntry)

-- | Checks whether you have the required permissions for the action, without
-- actually making the request, and provides an error response. If you have
-- the required permissions, the error response is @DryRunOperation@.
-- Otherwise, it is @UnauthorizedOperation@.
replaceNetworkAclEntry_dryRun :: Lens.Lens' ReplaceNetworkAclEntry (Prelude.Maybe Prelude.Bool)
replaceNetworkAclEntry_dryRun :: Lens' ReplaceNetworkAclEntry (Maybe Bool)
replaceNetworkAclEntry_dryRun = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ReplaceNetworkAclEntry' {Maybe Bool
dryRun :: Maybe Bool
$sel:dryRun:ReplaceNetworkAclEntry' :: ReplaceNetworkAclEntry -> Maybe Bool
dryRun} -> Maybe Bool
dryRun) (\s :: ReplaceNetworkAclEntry
s@ReplaceNetworkAclEntry' {} Maybe Bool
a -> ReplaceNetworkAclEntry
s {$sel:dryRun:ReplaceNetworkAclEntry' :: Maybe Bool
dryRun = Maybe Bool
a} :: ReplaceNetworkAclEntry)

-- | ICMP protocol: The ICMP or ICMPv6 type and code. Required if specifying
-- protocol 1 (ICMP) or protocol 58 (ICMPv6) with an IPv6 CIDR block.
replaceNetworkAclEntry_icmpTypeCode :: Lens.Lens' ReplaceNetworkAclEntry (Prelude.Maybe IcmpTypeCode)
replaceNetworkAclEntry_icmpTypeCode :: Lens' ReplaceNetworkAclEntry (Maybe IcmpTypeCode)
replaceNetworkAclEntry_icmpTypeCode = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ReplaceNetworkAclEntry' {Maybe IcmpTypeCode
icmpTypeCode :: Maybe IcmpTypeCode
$sel:icmpTypeCode:ReplaceNetworkAclEntry' :: ReplaceNetworkAclEntry -> Maybe IcmpTypeCode
icmpTypeCode} -> Maybe IcmpTypeCode
icmpTypeCode) (\s :: ReplaceNetworkAclEntry
s@ReplaceNetworkAclEntry' {} Maybe IcmpTypeCode
a -> ReplaceNetworkAclEntry
s {$sel:icmpTypeCode:ReplaceNetworkAclEntry' :: Maybe IcmpTypeCode
icmpTypeCode = Maybe IcmpTypeCode
a} :: ReplaceNetworkAclEntry)

-- | The IPv6 network range to allow or deny, in CIDR notation (for example
-- @2001:bd8:1234:1a00::\/64@).
replaceNetworkAclEntry_ipv6CidrBlock :: Lens.Lens' ReplaceNetworkAclEntry (Prelude.Maybe Prelude.Text)
replaceNetworkAclEntry_ipv6CidrBlock :: Lens' ReplaceNetworkAclEntry (Maybe Text)
replaceNetworkAclEntry_ipv6CidrBlock = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ReplaceNetworkAclEntry' {Maybe Text
ipv6CidrBlock :: Maybe Text
$sel:ipv6CidrBlock:ReplaceNetworkAclEntry' :: ReplaceNetworkAclEntry -> Maybe Text
ipv6CidrBlock} -> Maybe Text
ipv6CidrBlock) (\s :: ReplaceNetworkAclEntry
s@ReplaceNetworkAclEntry' {} Maybe Text
a -> ReplaceNetworkAclEntry
s {$sel:ipv6CidrBlock:ReplaceNetworkAclEntry' :: Maybe Text
ipv6CidrBlock = Maybe Text
a} :: ReplaceNetworkAclEntry)

-- | TCP or UDP protocols: The range of ports the rule applies to. Required
-- if specifying protocol 6 (TCP) or 17 (UDP).
replaceNetworkAclEntry_portRange :: Lens.Lens' ReplaceNetworkAclEntry (Prelude.Maybe PortRange)
replaceNetworkAclEntry_portRange :: Lens' ReplaceNetworkAclEntry (Maybe PortRange)
replaceNetworkAclEntry_portRange = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ReplaceNetworkAclEntry' {Maybe PortRange
portRange :: Maybe PortRange
$sel:portRange:ReplaceNetworkAclEntry' :: ReplaceNetworkAclEntry -> Maybe PortRange
portRange} -> Maybe PortRange
portRange) (\s :: ReplaceNetworkAclEntry
s@ReplaceNetworkAclEntry' {} Maybe PortRange
a -> ReplaceNetworkAclEntry
s {$sel:portRange:ReplaceNetworkAclEntry' :: Maybe PortRange
portRange = Maybe PortRange
a} :: ReplaceNetworkAclEntry)

-- | Indicates whether to replace the egress rule.
--
-- Default: If no value is specified, we replace the ingress rule.
replaceNetworkAclEntry_egress :: Lens.Lens' ReplaceNetworkAclEntry Prelude.Bool
replaceNetworkAclEntry_egress :: Lens' ReplaceNetworkAclEntry Bool
replaceNetworkAclEntry_egress = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ReplaceNetworkAclEntry' {Bool
egress :: Bool
$sel:egress:ReplaceNetworkAclEntry' :: ReplaceNetworkAclEntry -> Bool
egress} -> Bool
egress) (\s :: ReplaceNetworkAclEntry
s@ReplaceNetworkAclEntry' {} Bool
a -> ReplaceNetworkAclEntry
s {$sel:egress:ReplaceNetworkAclEntry' :: Bool
egress = Bool
a} :: ReplaceNetworkAclEntry)

-- | The ID of the ACL.
replaceNetworkAclEntry_networkAclId :: Lens.Lens' ReplaceNetworkAclEntry Prelude.Text
replaceNetworkAclEntry_networkAclId :: Lens' ReplaceNetworkAclEntry Text
replaceNetworkAclEntry_networkAclId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ReplaceNetworkAclEntry' {Text
networkAclId :: Text
$sel:networkAclId:ReplaceNetworkAclEntry' :: ReplaceNetworkAclEntry -> Text
networkAclId} -> Text
networkAclId) (\s :: ReplaceNetworkAclEntry
s@ReplaceNetworkAclEntry' {} Text
a -> ReplaceNetworkAclEntry
s {$sel:networkAclId:ReplaceNetworkAclEntry' :: Text
networkAclId = Text
a} :: ReplaceNetworkAclEntry)

-- | The protocol number. A value of \"-1\" means all protocols. If you
-- specify \"-1\" or a protocol number other than \"6\" (TCP), \"17\"
-- (UDP), or \"1\" (ICMP), traffic on all ports is allowed, regardless of
-- any ports or ICMP types or codes that you specify. If you specify
-- protocol \"58\" (ICMPv6) and specify an IPv4 CIDR block, traffic for all
-- ICMP types and codes allowed, regardless of any that you specify. If you
-- specify protocol \"58\" (ICMPv6) and specify an IPv6 CIDR block, you
-- must specify an ICMP type and code.
replaceNetworkAclEntry_protocol :: Lens.Lens' ReplaceNetworkAclEntry Prelude.Text
replaceNetworkAclEntry_protocol :: Lens' ReplaceNetworkAclEntry Text
replaceNetworkAclEntry_protocol = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ReplaceNetworkAclEntry' {Text
protocol :: Text
$sel:protocol:ReplaceNetworkAclEntry' :: ReplaceNetworkAclEntry -> Text
protocol} -> Text
protocol) (\s :: ReplaceNetworkAclEntry
s@ReplaceNetworkAclEntry' {} Text
a -> ReplaceNetworkAclEntry
s {$sel:protocol:ReplaceNetworkAclEntry' :: Text
protocol = Text
a} :: ReplaceNetworkAclEntry)

-- | Indicates whether to allow or deny the traffic that matches the rule.
replaceNetworkAclEntry_ruleAction :: Lens.Lens' ReplaceNetworkAclEntry RuleAction
replaceNetworkAclEntry_ruleAction :: Lens' ReplaceNetworkAclEntry RuleAction
replaceNetworkAclEntry_ruleAction = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ReplaceNetworkAclEntry' {RuleAction
ruleAction :: RuleAction
$sel:ruleAction:ReplaceNetworkAclEntry' :: ReplaceNetworkAclEntry -> RuleAction
ruleAction} -> RuleAction
ruleAction) (\s :: ReplaceNetworkAclEntry
s@ReplaceNetworkAclEntry' {} RuleAction
a -> ReplaceNetworkAclEntry
s {$sel:ruleAction:ReplaceNetworkAclEntry' :: RuleAction
ruleAction = RuleAction
a} :: ReplaceNetworkAclEntry)

-- | The rule number of the entry to replace.
replaceNetworkAclEntry_ruleNumber :: Lens.Lens' ReplaceNetworkAclEntry Prelude.Int
replaceNetworkAclEntry_ruleNumber :: Lens' ReplaceNetworkAclEntry Int
replaceNetworkAclEntry_ruleNumber = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ReplaceNetworkAclEntry' {Int
ruleNumber :: Int
$sel:ruleNumber:ReplaceNetworkAclEntry' :: ReplaceNetworkAclEntry -> Int
ruleNumber} -> Int
ruleNumber) (\s :: ReplaceNetworkAclEntry
s@ReplaceNetworkAclEntry' {} Int
a -> ReplaceNetworkAclEntry
s {$sel:ruleNumber:ReplaceNetworkAclEntry' :: Int
ruleNumber = Int
a} :: ReplaceNetworkAclEntry)

instance Core.AWSRequest ReplaceNetworkAclEntry where
  type
    AWSResponse ReplaceNetworkAclEntry =
      ReplaceNetworkAclEntryResponse
  request :: (Service -> Service)
-> ReplaceNetworkAclEntry -> Request ReplaceNetworkAclEntry
request Service -> Service
overrides =
    forall a. ToRequest a => Service -> a -> Request a
Request.postQuery (Service -> Service
overrides Service
defaultService)
  response :: forall (m :: * -> *).
MonadResource m =>
(ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy ReplaceNetworkAclEntry
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse ReplaceNetworkAclEntry)))
response =
    forall (m :: * -> *) a.
MonadResource m =>
AWSResponse a
-> (ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy a
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse a)))
Response.receiveNull
      ReplaceNetworkAclEntryResponse
ReplaceNetworkAclEntryResponse'

instance Prelude.Hashable ReplaceNetworkAclEntry where
  hashWithSalt :: Int -> ReplaceNetworkAclEntry -> Int
hashWithSalt Int
_salt ReplaceNetworkAclEntry' {Bool
Int
Maybe Bool
Maybe Text
Maybe IcmpTypeCode
Maybe PortRange
Text
RuleAction
ruleNumber :: Int
ruleAction :: RuleAction
protocol :: Text
networkAclId :: Text
egress :: Bool
portRange :: Maybe PortRange
ipv6CidrBlock :: Maybe Text
icmpTypeCode :: Maybe IcmpTypeCode
dryRun :: Maybe Bool
cidrBlock :: Maybe Text
$sel:ruleNumber:ReplaceNetworkAclEntry' :: ReplaceNetworkAclEntry -> Int
$sel:ruleAction:ReplaceNetworkAclEntry' :: ReplaceNetworkAclEntry -> RuleAction
$sel:protocol:ReplaceNetworkAclEntry' :: ReplaceNetworkAclEntry -> Text
$sel:networkAclId:ReplaceNetworkAclEntry' :: ReplaceNetworkAclEntry -> Text
$sel:egress:ReplaceNetworkAclEntry' :: ReplaceNetworkAclEntry -> Bool
$sel:portRange:ReplaceNetworkAclEntry' :: ReplaceNetworkAclEntry -> Maybe PortRange
$sel:ipv6CidrBlock:ReplaceNetworkAclEntry' :: ReplaceNetworkAclEntry -> Maybe Text
$sel:icmpTypeCode:ReplaceNetworkAclEntry' :: ReplaceNetworkAclEntry -> Maybe IcmpTypeCode
$sel:dryRun:ReplaceNetworkAclEntry' :: ReplaceNetworkAclEntry -> Maybe Bool
$sel:cidrBlock:ReplaceNetworkAclEntry' :: ReplaceNetworkAclEntry -> Maybe Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
cidrBlock
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Bool
dryRun
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe IcmpTypeCode
icmpTypeCode
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
ipv6CidrBlock
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe PortRange
portRange
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Bool
egress
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
networkAclId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
protocol
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` RuleAction
ruleAction
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Int
ruleNumber

instance Prelude.NFData ReplaceNetworkAclEntry where
  rnf :: ReplaceNetworkAclEntry -> ()
rnf ReplaceNetworkAclEntry' {Bool
Int
Maybe Bool
Maybe Text
Maybe IcmpTypeCode
Maybe PortRange
Text
RuleAction
ruleNumber :: Int
ruleAction :: RuleAction
protocol :: Text
networkAclId :: Text
egress :: Bool
portRange :: Maybe PortRange
ipv6CidrBlock :: Maybe Text
icmpTypeCode :: Maybe IcmpTypeCode
dryRun :: Maybe Bool
cidrBlock :: Maybe Text
$sel:ruleNumber:ReplaceNetworkAclEntry' :: ReplaceNetworkAclEntry -> Int
$sel:ruleAction:ReplaceNetworkAclEntry' :: ReplaceNetworkAclEntry -> RuleAction
$sel:protocol:ReplaceNetworkAclEntry' :: ReplaceNetworkAclEntry -> Text
$sel:networkAclId:ReplaceNetworkAclEntry' :: ReplaceNetworkAclEntry -> Text
$sel:egress:ReplaceNetworkAclEntry' :: ReplaceNetworkAclEntry -> Bool
$sel:portRange:ReplaceNetworkAclEntry' :: ReplaceNetworkAclEntry -> Maybe PortRange
$sel:ipv6CidrBlock:ReplaceNetworkAclEntry' :: ReplaceNetworkAclEntry -> Maybe Text
$sel:icmpTypeCode:ReplaceNetworkAclEntry' :: ReplaceNetworkAclEntry -> Maybe IcmpTypeCode
$sel:dryRun:ReplaceNetworkAclEntry' :: ReplaceNetworkAclEntry -> Maybe Bool
$sel:cidrBlock:ReplaceNetworkAclEntry' :: ReplaceNetworkAclEntry -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
cidrBlock
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Bool
dryRun
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe IcmpTypeCode
icmpTypeCode
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
ipv6CidrBlock
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe PortRange
portRange
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Bool
egress
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
networkAclId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
protocol
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf RuleAction
ruleAction
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
ruleNumber

instance Data.ToHeaders ReplaceNetworkAclEntry where
  toHeaders :: ReplaceNetworkAclEntry -> [Header]
toHeaders = forall a b. a -> b -> a
Prelude.const forall a. Monoid a => a
Prelude.mempty

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

instance Data.ToQuery ReplaceNetworkAclEntry where
  toQuery :: ReplaceNetworkAclEntry -> QueryString
toQuery ReplaceNetworkAclEntry' {Bool
Int
Maybe Bool
Maybe Text
Maybe IcmpTypeCode
Maybe PortRange
Text
RuleAction
ruleNumber :: Int
ruleAction :: RuleAction
protocol :: Text
networkAclId :: Text
egress :: Bool
portRange :: Maybe PortRange
ipv6CidrBlock :: Maybe Text
icmpTypeCode :: Maybe IcmpTypeCode
dryRun :: Maybe Bool
cidrBlock :: Maybe Text
$sel:ruleNumber:ReplaceNetworkAclEntry' :: ReplaceNetworkAclEntry -> Int
$sel:ruleAction:ReplaceNetworkAclEntry' :: ReplaceNetworkAclEntry -> RuleAction
$sel:protocol:ReplaceNetworkAclEntry' :: ReplaceNetworkAclEntry -> Text
$sel:networkAclId:ReplaceNetworkAclEntry' :: ReplaceNetworkAclEntry -> Text
$sel:egress:ReplaceNetworkAclEntry' :: ReplaceNetworkAclEntry -> Bool
$sel:portRange:ReplaceNetworkAclEntry' :: ReplaceNetworkAclEntry -> Maybe PortRange
$sel:ipv6CidrBlock:ReplaceNetworkAclEntry' :: ReplaceNetworkAclEntry -> Maybe Text
$sel:icmpTypeCode:ReplaceNetworkAclEntry' :: ReplaceNetworkAclEntry -> Maybe IcmpTypeCode
$sel:dryRun:ReplaceNetworkAclEntry' :: ReplaceNetworkAclEntry -> Maybe Bool
$sel:cidrBlock:ReplaceNetworkAclEntry' :: ReplaceNetworkAclEntry -> Maybe Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"Action"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: (ByteString
"ReplaceNetworkAclEntry" :: Prelude.ByteString),
        ByteString
"Version"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: (ByteString
"2016-11-15" :: Prelude.ByteString),
        ByteString
"CidrBlock" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Text
cidrBlock,
        ByteString
"DryRun" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Bool
dryRun,
        ByteString
"Icmp" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe IcmpTypeCode
icmpTypeCode,
        ByteString
"Ipv6CidrBlock" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Text
ipv6CidrBlock,
        ByteString
"PortRange" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe PortRange
portRange,
        ByteString
"Egress" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Bool
egress,
        ByteString
"NetworkAclId" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Text
networkAclId,
        ByteString
"Protocol" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Text
protocol,
        ByteString
"RuleAction" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: RuleAction
ruleAction,
        ByteString
"RuleNumber" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Int
ruleNumber
      ]

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

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

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