{-# 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.ReplaceNetworkAclAssociation
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Changes which network ACL a subnet is associated with. By default when
-- you create a subnet, it\'s automatically associated with the default
-- 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/.
--
-- This is an idempotent operation.
module Amazonka.EC2.ReplaceNetworkAclAssociation
  ( -- * Creating a Request
    ReplaceNetworkAclAssociation (..),
    newReplaceNetworkAclAssociation,

    -- * Request Lenses
    replaceNetworkAclAssociation_dryRun,
    replaceNetworkAclAssociation_associationId,
    replaceNetworkAclAssociation_networkAclId,

    -- * Destructuring the Response
    ReplaceNetworkAclAssociationResponse (..),
    newReplaceNetworkAclAssociationResponse,

    -- * Response Lenses
    replaceNetworkAclAssociationResponse_newAssociationId,
    replaceNetworkAclAssociationResponse_httpStatus,
  )
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:/ 'newReplaceNetworkAclAssociation' smart constructor.
data ReplaceNetworkAclAssociation = ReplaceNetworkAclAssociation'
  { -- | 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@.
    ReplaceNetworkAclAssociation -> Maybe Bool
dryRun :: Prelude.Maybe Prelude.Bool,
    -- | The ID of the current association between the original network ACL and
    -- the subnet.
    ReplaceNetworkAclAssociation -> Text
associationId :: Prelude.Text,
    -- | The ID of the new network ACL to associate with the subnet.
    ReplaceNetworkAclAssociation -> Text
networkAclId :: Prelude.Text
  }
  deriving (ReplaceNetworkAclAssociation
-> ReplaceNetworkAclAssociation -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ReplaceNetworkAclAssociation
-> ReplaceNetworkAclAssociation -> Bool
$c/= :: ReplaceNetworkAclAssociation
-> ReplaceNetworkAclAssociation -> Bool
== :: ReplaceNetworkAclAssociation
-> ReplaceNetworkAclAssociation -> Bool
$c== :: ReplaceNetworkAclAssociation
-> ReplaceNetworkAclAssociation -> Bool
Prelude.Eq, ReadPrec [ReplaceNetworkAclAssociation]
ReadPrec ReplaceNetworkAclAssociation
Int -> ReadS ReplaceNetworkAclAssociation
ReadS [ReplaceNetworkAclAssociation]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ReplaceNetworkAclAssociation]
$creadListPrec :: ReadPrec [ReplaceNetworkAclAssociation]
readPrec :: ReadPrec ReplaceNetworkAclAssociation
$creadPrec :: ReadPrec ReplaceNetworkAclAssociation
readList :: ReadS [ReplaceNetworkAclAssociation]
$creadList :: ReadS [ReplaceNetworkAclAssociation]
readsPrec :: Int -> ReadS ReplaceNetworkAclAssociation
$creadsPrec :: Int -> ReadS ReplaceNetworkAclAssociation
Prelude.Read, Int -> ReplaceNetworkAclAssociation -> ShowS
[ReplaceNetworkAclAssociation] -> ShowS
ReplaceNetworkAclAssociation -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ReplaceNetworkAclAssociation] -> ShowS
$cshowList :: [ReplaceNetworkAclAssociation] -> ShowS
show :: ReplaceNetworkAclAssociation -> String
$cshow :: ReplaceNetworkAclAssociation -> String
showsPrec :: Int -> ReplaceNetworkAclAssociation -> ShowS
$cshowsPrec :: Int -> ReplaceNetworkAclAssociation -> ShowS
Prelude.Show, forall x.
Rep ReplaceNetworkAclAssociation x -> ReplaceNetworkAclAssociation
forall x.
ReplaceNetworkAclAssociation -> Rep ReplaceNetworkAclAssociation x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep ReplaceNetworkAclAssociation x -> ReplaceNetworkAclAssociation
$cfrom :: forall x.
ReplaceNetworkAclAssociation -> Rep ReplaceNetworkAclAssociation x
Prelude.Generic)

-- |
-- Create a value of 'ReplaceNetworkAclAssociation' 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:
--
-- 'dryRun', 'replaceNetworkAclAssociation_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@.
--
-- 'associationId', 'replaceNetworkAclAssociation_associationId' - The ID of the current association between the original network ACL and
-- the subnet.
--
-- 'networkAclId', 'replaceNetworkAclAssociation_networkAclId' - The ID of the new network ACL to associate with the subnet.
newReplaceNetworkAclAssociation ::
  -- | 'associationId'
  Prelude.Text ->
  -- | 'networkAclId'
  Prelude.Text ->
  ReplaceNetworkAclAssociation
newReplaceNetworkAclAssociation :: Text -> Text -> ReplaceNetworkAclAssociation
newReplaceNetworkAclAssociation
  Text
pAssociationId_
  Text
pNetworkAclId_ =
    ReplaceNetworkAclAssociation'
      { $sel:dryRun:ReplaceNetworkAclAssociation' :: Maybe Bool
dryRun =
          forall a. Maybe a
Prelude.Nothing,
        $sel:associationId:ReplaceNetworkAclAssociation' :: Text
associationId = Text
pAssociationId_,
        $sel:networkAclId:ReplaceNetworkAclAssociation' :: Text
networkAclId = Text
pNetworkAclId_
      }

-- | 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@.
replaceNetworkAclAssociation_dryRun :: Lens.Lens' ReplaceNetworkAclAssociation (Prelude.Maybe Prelude.Bool)
replaceNetworkAclAssociation_dryRun :: Lens' ReplaceNetworkAclAssociation (Maybe Bool)
replaceNetworkAclAssociation_dryRun = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ReplaceNetworkAclAssociation' {Maybe Bool
dryRun :: Maybe Bool
$sel:dryRun:ReplaceNetworkAclAssociation' :: ReplaceNetworkAclAssociation -> Maybe Bool
dryRun} -> Maybe Bool
dryRun) (\s :: ReplaceNetworkAclAssociation
s@ReplaceNetworkAclAssociation' {} Maybe Bool
a -> ReplaceNetworkAclAssociation
s {$sel:dryRun:ReplaceNetworkAclAssociation' :: Maybe Bool
dryRun = Maybe Bool
a} :: ReplaceNetworkAclAssociation)

-- | The ID of the current association between the original network ACL and
-- the subnet.
replaceNetworkAclAssociation_associationId :: Lens.Lens' ReplaceNetworkAclAssociation Prelude.Text
replaceNetworkAclAssociation_associationId :: Lens' ReplaceNetworkAclAssociation Text
replaceNetworkAclAssociation_associationId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ReplaceNetworkAclAssociation' {Text
associationId :: Text
$sel:associationId:ReplaceNetworkAclAssociation' :: ReplaceNetworkAclAssociation -> Text
associationId} -> Text
associationId) (\s :: ReplaceNetworkAclAssociation
s@ReplaceNetworkAclAssociation' {} Text
a -> ReplaceNetworkAclAssociation
s {$sel:associationId:ReplaceNetworkAclAssociation' :: Text
associationId = Text
a} :: ReplaceNetworkAclAssociation)

-- | The ID of the new network ACL to associate with the subnet.
replaceNetworkAclAssociation_networkAclId :: Lens.Lens' ReplaceNetworkAclAssociation Prelude.Text
replaceNetworkAclAssociation_networkAclId :: Lens' ReplaceNetworkAclAssociation Text
replaceNetworkAclAssociation_networkAclId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ReplaceNetworkAclAssociation' {Text
networkAclId :: Text
$sel:networkAclId:ReplaceNetworkAclAssociation' :: ReplaceNetworkAclAssociation -> Text
networkAclId} -> Text
networkAclId) (\s :: ReplaceNetworkAclAssociation
s@ReplaceNetworkAclAssociation' {} Text
a -> ReplaceNetworkAclAssociation
s {$sel:networkAclId:ReplaceNetworkAclAssociation' :: Text
networkAclId = Text
a} :: ReplaceNetworkAclAssociation)

instance Core.AWSRequest ReplaceNetworkAclAssociation where
  type
    AWSResponse ReplaceNetworkAclAssociation =
      ReplaceNetworkAclAssociationResponse
  request :: (Service -> Service)
-> ReplaceNetworkAclAssociation
-> Request ReplaceNetworkAclAssociation
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 ReplaceNetworkAclAssociation
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse ReplaceNetworkAclAssociation)))
response =
    forall (m :: * -> *) a.
MonadResource m =>
(Int -> ResponseHeaders -> [Node] -> Either String (AWSResponse a))
-> (ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy a
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse a)))
Response.receiveXML
      ( \Int
s ResponseHeaders
h [Node]
x ->
          Maybe Text -> Int -> ReplaceNetworkAclAssociationResponse
ReplaceNetworkAclAssociationResponse'
            forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> ([Node]
x forall a. FromXML a => [Node] -> Text -> Either String (Maybe a)
Data..@? Text
"newAssociationId")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (forall (f :: * -> *) a. Applicative f => a -> f a
Prelude.pure (forall a. Enum a => a -> Int
Prelude.fromEnum Int
s))
      )

instance
  Prelude.Hashable
    ReplaceNetworkAclAssociation
  where
  hashWithSalt :: Int -> ReplaceNetworkAclAssociation -> Int
hashWithSalt Int
_salt ReplaceNetworkAclAssociation' {Maybe Bool
Text
networkAclId :: Text
associationId :: Text
dryRun :: Maybe Bool
$sel:networkAclId:ReplaceNetworkAclAssociation' :: ReplaceNetworkAclAssociation -> Text
$sel:associationId:ReplaceNetworkAclAssociation' :: ReplaceNetworkAclAssociation -> Text
$sel:dryRun:ReplaceNetworkAclAssociation' :: ReplaceNetworkAclAssociation -> Maybe Bool
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Bool
dryRun
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
associationId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
networkAclId

instance Prelude.NFData ReplaceNetworkAclAssociation where
  rnf :: ReplaceNetworkAclAssociation -> ()
rnf ReplaceNetworkAclAssociation' {Maybe Bool
Text
networkAclId :: Text
associationId :: Text
dryRun :: Maybe Bool
$sel:networkAclId:ReplaceNetworkAclAssociation' :: ReplaceNetworkAclAssociation -> Text
$sel:associationId:ReplaceNetworkAclAssociation' :: ReplaceNetworkAclAssociation -> Text
$sel:dryRun:ReplaceNetworkAclAssociation' :: ReplaceNetworkAclAssociation -> Maybe Bool
..} =
    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 Text
associationId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
networkAclId

instance Data.ToHeaders ReplaceNetworkAclAssociation where
  toHeaders :: ReplaceNetworkAclAssociation -> ResponseHeaders
toHeaders = forall a b. a -> b -> a
Prelude.const forall a. Monoid a => a
Prelude.mempty

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

instance Data.ToQuery ReplaceNetworkAclAssociation where
  toQuery :: ReplaceNetworkAclAssociation -> QueryString
toQuery ReplaceNetworkAclAssociation' {Maybe Bool
Text
networkAclId :: Text
associationId :: Text
dryRun :: Maybe Bool
$sel:networkAclId:ReplaceNetworkAclAssociation' :: ReplaceNetworkAclAssociation -> Text
$sel:associationId:ReplaceNetworkAclAssociation' :: ReplaceNetworkAclAssociation -> Text
$sel:dryRun:ReplaceNetworkAclAssociation' :: ReplaceNetworkAclAssociation -> Maybe Bool
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"Action"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: ( ByteString
"ReplaceNetworkAclAssociation" ::
                      Prelude.ByteString
                  ),
        ByteString
"Version"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: (ByteString
"2016-11-15" :: Prelude.ByteString),
        ByteString
"DryRun" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Bool
dryRun,
        ByteString
"AssociationId" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Text
associationId,
        ByteString
"NetworkAclId" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Text
networkAclId
      ]

-- | /See:/ 'newReplaceNetworkAclAssociationResponse' smart constructor.
data ReplaceNetworkAclAssociationResponse = ReplaceNetworkAclAssociationResponse'
  { -- | The ID of the new association.
    ReplaceNetworkAclAssociationResponse -> Maybe Text
newAssociationId' :: Prelude.Maybe Prelude.Text,
    -- | The response's http status code.
    ReplaceNetworkAclAssociationResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (ReplaceNetworkAclAssociationResponse
-> ReplaceNetworkAclAssociationResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ReplaceNetworkAclAssociationResponse
-> ReplaceNetworkAclAssociationResponse -> Bool
$c/= :: ReplaceNetworkAclAssociationResponse
-> ReplaceNetworkAclAssociationResponse -> Bool
== :: ReplaceNetworkAclAssociationResponse
-> ReplaceNetworkAclAssociationResponse -> Bool
$c== :: ReplaceNetworkAclAssociationResponse
-> ReplaceNetworkAclAssociationResponse -> Bool
Prelude.Eq, ReadPrec [ReplaceNetworkAclAssociationResponse]
ReadPrec ReplaceNetworkAclAssociationResponse
Int -> ReadS ReplaceNetworkAclAssociationResponse
ReadS [ReplaceNetworkAclAssociationResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ReplaceNetworkAclAssociationResponse]
$creadListPrec :: ReadPrec [ReplaceNetworkAclAssociationResponse]
readPrec :: ReadPrec ReplaceNetworkAclAssociationResponse
$creadPrec :: ReadPrec ReplaceNetworkAclAssociationResponse
readList :: ReadS [ReplaceNetworkAclAssociationResponse]
$creadList :: ReadS [ReplaceNetworkAclAssociationResponse]
readsPrec :: Int -> ReadS ReplaceNetworkAclAssociationResponse
$creadsPrec :: Int -> ReadS ReplaceNetworkAclAssociationResponse
Prelude.Read, Int -> ReplaceNetworkAclAssociationResponse -> ShowS
[ReplaceNetworkAclAssociationResponse] -> ShowS
ReplaceNetworkAclAssociationResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ReplaceNetworkAclAssociationResponse] -> ShowS
$cshowList :: [ReplaceNetworkAclAssociationResponse] -> ShowS
show :: ReplaceNetworkAclAssociationResponse -> String
$cshow :: ReplaceNetworkAclAssociationResponse -> String
showsPrec :: Int -> ReplaceNetworkAclAssociationResponse -> ShowS
$cshowsPrec :: Int -> ReplaceNetworkAclAssociationResponse -> ShowS
Prelude.Show, forall x.
Rep ReplaceNetworkAclAssociationResponse x
-> ReplaceNetworkAclAssociationResponse
forall x.
ReplaceNetworkAclAssociationResponse
-> Rep ReplaceNetworkAclAssociationResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep ReplaceNetworkAclAssociationResponse x
-> ReplaceNetworkAclAssociationResponse
$cfrom :: forall x.
ReplaceNetworkAclAssociationResponse
-> Rep ReplaceNetworkAclAssociationResponse x
Prelude.Generic)

-- |
-- Create a value of 'ReplaceNetworkAclAssociationResponse' 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:
--
-- 'newAssociationId'', 'replaceNetworkAclAssociationResponse_newAssociationId' - The ID of the new association.
--
-- 'httpStatus', 'replaceNetworkAclAssociationResponse_httpStatus' - The response's http status code.
newReplaceNetworkAclAssociationResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  ReplaceNetworkAclAssociationResponse
newReplaceNetworkAclAssociationResponse :: Int -> ReplaceNetworkAclAssociationResponse
newReplaceNetworkAclAssociationResponse Int
pHttpStatus_ =
  ReplaceNetworkAclAssociationResponse'
    { $sel:newAssociationId':ReplaceNetworkAclAssociationResponse' :: Maybe Text
newAssociationId' =
        forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:ReplaceNetworkAclAssociationResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | The ID of the new association.
replaceNetworkAclAssociationResponse_newAssociationId :: Lens.Lens' ReplaceNetworkAclAssociationResponse (Prelude.Maybe Prelude.Text)
replaceNetworkAclAssociationResponse_newAssociationId :: Lens' ReplaceNetworkAclAssociationResponse (Maybe Text)
replaceNetworkAclAssociationResponse_newAssociationId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ReplaceNetworkAclAssociationResponse' {Maybe Text
newAssociationId' :: Maybe Text
$sel:newAssociationId':ReplaceNetworkAclAssociationResponse' :: ReplaceNetworkAclAssociationResponse -> Maybe Text
newAssociationId'} -> Maybe Text
newAssociationId') (\s :: ReplaceNetworkAclAssociationResponse
s@ReplaceNetworkAclAssociationResponse' {} Maybe Text
a -> ReplaceNetworkAclAssociationResponse
s {$sel:newAssociationId':ReplaceNetworkAclAssociationResponse' :: Maybe Text
newAssociationId' = Maybe Text
a} :: ReplaceNetworkAclAssociationResponse)

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

instance
  Prelude.NFData
    ReplaceNetworkAclAssociationResponse
  where
  rnf :: ReplaceNetworkAclAssociationResponse -> ()
rnf ReplaceNetworkAclAssociationResponse' {Int
Maybe Text
httpStatus :: Int
newAssociationId' :: Maybe Text
$sel:httpStatus:ReplaceNetworkAclAssociationResponse' :: ReplaceNetworkAclAssociationResponse -> Int
$sel:newAssociationId':ReplaceNetworkAclAssociationResponse' :: ReplaceNetworkAclAssociationResponse -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
newAssociationId'
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus