{-# 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.DisassociateSubnetCidrBlock
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Disassociates a CIDR block from a subnet. Currently, you can
-- disassociate an IPv6 CIDR block only. You must detach or delete all
-- gateways and resources that are associated with the CIDR block before
-- you can disassociate it.
module Amazonka.EC2.DisassociateSubnetCidrBlock
  ( -- * Creating a Request
    DisassociateSubnetCidrBlock (..),
    newDisassociateSubnetCidrBlock,

    -- * Request Lenses
    disassociateSubnetCidrBlock_associationId,

    -- * Destructuring the Response
    DisassociateSubnetCidrBlockResponse (..),
    newDisassociateSubnetCidrBlockResponse,

    -- * Response Lenses
    disassociateSubnetCidrBlockResponse_ipv6CidrBlockAssociation,
    disassociateSubnetCidrBlockResponse_subnetId,
    disassociateSubnetCidrBlockResponse_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:/ 'newDisassociateSubnetCidrBlock' smart constructor.
data DisassociateSubnetCidrBlock = DisassociateSubnetCidrBlock'
  { -- | The association ID for the CIDR block.
    DisassociateSubnetCidrBlock -> Text
associationId :: Prelude.Text
  }
  deriving (DisassociateSubnetCidrBlock -> DisassociateSubnetCidrBlock -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DisassociateSubnetCidrBlock -> DisassociateSubnetCidrBlock -> Bool
$c/= :: DisassociateSubnetCidrBlock -> DisassociateSubnetCidrBlock -> Bool
== :: DisassociateSubnetCidrBlock -> DisassociateSubnetCidrBlock -> Bool
$c== :: DisassociateSubnetCidrBlock -> DisassociateSubnetCidrBlock -> Bool
Prelude.Eq, ReadPrec [DisassociateSubnetCidrBlock]
ReadPrec DisassociateSubnetCidrBlock
Int -> ReadS DisassociateSubnetCidrBlock
ReadS [DisassociateSubnetCidrBlock]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DisassociateSubnetCidrBlock]
$creadListPrec :: ReadPrec [DisassociateSubnetCidrBlock]
readPrec :: ReadPrec DisassociateSubnetCidrBlock
$creadPrec :: ReadPrec DisassociateSubnetCidrBlock
readList :: ReadS [DisassociateSubnetCidrBlock]
$creadList :: ReadS [DisassociateSubnetCidrBlock]
readsPrec :: Int -> ReadS DisassociateSubnetCidrBlock
$creadsPrec :: Int -> ReadS DisassociateSubnetCidrBlock
Prelude.Read, Int -> DisassociateSubnetCidrBlock -> ShowS
[DisassociateSubnetCidrBlock] -> ShowS
DisassociateSubnetCidrBlock -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DisassociateSubnetCidrBlock] -> ShowS
$cshowList :: [DisassociateSubnetCidrBlock] -> ShowS
show :: DisassociateSubnetCidrBlock -> String
$cshow :: DisassociateSubnetCidrBlock -> String
showsPrec :: Int -> DisassociateSubnetCidrBlock -> ShowS
$cshowsPrec :: Int -> DisassociateSubnetCidrBlock -> ShowS
Prelude.Show, forall x.
Rep DisassociateSubnetCidrBlock x -> DisassociateSubnetCidrBlock
forall x.
DisassociateSubnetCidrBlock -> Rep DisassociateSubnetCidrBlock x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep DisassociateSubnetCidrBlock x -> DisassociateSubnetCidrBlock
$cfrom :: forall x.
DisassociateSubnetCidrBlock -> Rep DisassociateSubnetCidrBlock x
Prelude.Generic)

-- |
-- Create a value of 'DisassociateSubnetCidrBlock' 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:
--
-- 'associationId', 'disassociateSubnetCidrBlock_associationId' - The association ID for the CIDR block.
newDisassociateSubnetCidrBlock ::
  -- | 'associationId'
  Prelude.Text ->
  DisassociateSubnetCidrBlock
newDisassociateSubnetCidrBlock :: Text -> DisassociateSubnetCidrBlock
newDisassociateSubnetCidrBlock Text
pAssociationId_ =
  DisassociateSubnetCidrBlock'
    { $sel:associationId:DisassociateSubnetCidrBlock' :: Text
associationId =
        Text
pAssociationId_
    }

-- | The association ID for the CIDR block.
disassociateSubnetCidrBlock_associationId :: Lens.Lens' DisassociateSubnetCidrBlock Prelude.Text
disassociateSubnetCidrBlock_associationId :: Lens' DisassociateSubnetCidrBlock Text
disassociateSubnetCidrBlock_associationId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DisassociateSubnetCidrBlock' {Text
associationId :: Text
$sel:associationId:DisassociateSubnetCidrBlock' :: DisassociateSubnetCidrBlock -> Text
associationId} -> Text
associationId) (\s :: DisassociateSubnetCidrBlock
s@DisassociateSubnetCidrBlock' {} Text
a -> DisassociateSubnetCidrBlock
s {$sel:associationId:DisassociateSubnetCidrBlock' :: Text
associationId = Text
a} :: DisassociateSubnetCidrBlock)

instance Core.AWSRequest DisassociateSubnetCidrBlock where
  type
    AWSResponse DisassociateSubnetCidrBlock =
      DisassociateSubnetCidrBlockResponse
  request :: (Service -> Service)
-> DisassociateSubnetCidrBlock
-> Request DisassociateSubnetCidrBlock
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 DisassociateSubnetCidrBlock
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse DisassociateSubnetCidrBlock)))
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 SubnetIpv6CidrBlockAssociation
-> Maybe Text -> Int -> DisassociateSubnetCidrBlockResponse
DisassociateSubnetCidrBlockResponse'
            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
"ipv6CidrBlockAssociation")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> ([Node]
x forall a. FromXML a => [Node] -> Text -> Either String (Maybe a)
Data..@? Text
"subnetId")
            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 DisassociateSubnetCidrBlock where
  hashWithSalt :: Int -> DisassociateSubnetCidrBlock -> Int
hashWithSalt Int
_salt DisassociateSubnetCidrBlock' {Text
associationId :: Text
$sel:associationId:DisassociateSubnetCidrBlock' :: DisassociateSubnetCidrBlock -> Text
..} =
    Int
_salt forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
associationId

instance Prelude.NFData DisassociateSubnetCidrBlock where
  rnf :: DisassociateSubnetCidrBlock -> ()
rnf DisassociateSubnetCidrBlock' {Text
associationId :: Text
$sel:associationId:DisassociateSubnetCidrBlock' :: DisassociateSubnetCidrBlock -> Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Text
associationId

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

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

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

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

-- |
-- Create a value of 'DisassociateSubnetCidrBlockResponse' 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:
--
-- 'ipv6CidrBlockAssociation', 'disassociateSubnetCidrBlockResponse_ipv6CidrBlockAssociation' - Information about the IPv6 CIDR block association.
--
-- 'subnetId', 'disassociateSubnetCidrBlockResponse_subnetId' - The ID of the subnet.
--
-- 'httpStatus', 'disassociateSubnetCidrBlockResponse_httpStatus' - The response's http status code.
newDisassociateSubnetCidrBlockResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  DisassociateSubnetCidrBlockResponse
newDisassociateSubnetCidrBlockResponse :: Int -> DisassociateSubnetCidrBlockResponse
newDisassociateSubnetCidrBlockResponse Int
pHttpStatus_ =
  DisassociateSubnetCidrBlockResponse'
    { $sel:ipv6CidrBlockAssociation:DisassociateSubnetCidrBlockResponse' :: Maybe SubnetIpv6CidrBlockAssociation
ipv6CidrBlockAssociation =
        forall a. Maybe a
Prelude.Nothing,
      $sel:subnetId:DisassociateSubnetCidrBlockResponse' :: Maybe Text
subnetId = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:DisassociateSubnetCidrBlockResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | Information about the IPv6 CIDR block association.
disassociateSubnetCidrBlockResponse_ipv6CidrBlockAssociation :: Lens.Lens' DisassociateSubnetCidrBlockResponse (Prelude.Maybe SubnetIpv6CidrBlockAssociation)
disassociateSubnetCidrBlockResponse_ipv6CidrBlockAssociation :: Lens'
  DisassociateSubnetCidrBlockResponse
  (Maybe SubnetIpv6CidrBlockAssociation)
disassociateSubnetCidrBlockResponse_ipv6CidrBlockAssociation = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DisassociateSubnetCidrBlockResponse' {Maybe SubnetIpv6CidrBlockAssociation
ipv6CidrBlockAssociation :: Maybe SubnetIpv6CidrBlockAssociation
$sel:ipv6CidrBlockAssociation:DisassociateSubnetCidrBlockResponse' :: DisassociateSubnetCidrBlockResponse
-> Maybe SubnetIpv6CidrBlockAssociation
ipv6CidrBlockAssociation} -> Maybe SubnetIpv6CidrBlockAssociation
ipv6CidrBlockAssociation) (\s :: DisassociateSubnetCidrBlockResponse
s@DisassociateSubnetCidrBlockResponse' {} Maybe SubnetIpv6CidrBlockAssociation
a -> DisassociateSubnetCidrBlockResponse
s {$sel:ipv6CidrBlockAssociation:DisassociateSubnetCidrBlockResponse' :: Maybe SubnetIpv6CidrBlockAssociation
ipv6CidrBlockAssociation = Maybe SubnetIpv6CidrBlockAssociation
a} :: DisassociateSubnetCidrBlockResponse)

-- | The ID of the subnet.
disassociateSubnetCidrBlockResponse_subnetId :: Lens.Lens' DisassociateSubnetCidrBlockResponse (Prelude.Maybe Prelude.Text)
disassociateSubnetCidrBlockResponse_subnetId :: Lens' DisassociateSubnetCidrBlockResponse (Maybe Text)
disassociateSubnetCidrBlockResponse_subnetId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DisassociateSubnetCidrBlockResponse' {Maybe Text
subnetId :: Maybe Text
$sel:subnetId:DisassociateSubnetCidrBlockResponse' :: DisassociateSubnetCidrBlockResponse -> Maybe Text
subnetId} -> Maybe Text
subnetId) (\s :: DisassociateSubnetCidrBlockResponse
s@DisassociateSubnetCidrBlockResponse' {} Maybe Text
a -> DisassociateSubnetCidrBlockResponse
s {$sel:subnetId:DisassociateSubnetCidrBlockResponse' :: Maybe Text
subnetId = Maybe Text
a} :: DisassociateSubnetCidrBlockResponse)

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

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