{-# 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.DisassociateRouteTable
-- 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 subnet or gateway from a route table.
--
-- After you perform this action, the subnet no longer uses the routes in
-- the route table. Instead, it uses the routes in the VPC\'s main route
-- table. For more information about route tables, see
-- <https://docs.aws.amazon.com/vpc/latest/userguide/VPC_Route_Tables.html Route tables>
-- in the /Amazon Virtual Private Cloud User Guide/.
module Amazonka.EC2.DisassociateRouteTable
  ( -- * Creating a Request
    DisassociateRouteTable (..),
    newDisassociateRouteTable,

    -- * Request Lenses
    disassociateRouteTable_dryRun,
    disassociateRouteTable_associationId,

    -- * Destructuring the Response
    DisassociateRouteTableResponse (..),
    newDisassociateRouteTableResponse,
  )
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:/ 'newDisassociateRouteTable' smart constructor.
data DisassociateRouteTable = DisassociateRouteTable'
  { -- | 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@.
    DisassociateRouteTable -> Maybe Bool
dryRun :: Prelude.Maybe Prelude.Bool,
    -- | The association ID representing the current association between the
    -- route table and subnet or gateway.
    DisassociateRouteTable -> Text
associationId :: Prelude.Text
  }
  deriving (DisassociateRouteTable -> DisassociateRouteTable -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DisassociateRouteTable -> DisassociateRouteTable -> Bool
$c/= :: DisassociateRouteTable -> DisassociateRouteTable -> Bool
== :: DisassociateRouteTable -> DisassociateRouteTable -> Bool
$c== :: DisassociateRouteTable -> DisassociateRouteTable -> Bool
Prelude.Eq, ReadPrec [DisassociateRouteTable]
ReadPrec DisassociateRouteTable
Int -> ReadS DisassociateRouteTable
ReadS [DisassociateRouteTable]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DisassociateRouteTable]
$creadListPrec :: ReadPrec [DisassociateRouteTable]
readPrec :: ReadPrec DisassociateRouteTable
$creadPrec :: ReadPrec DisassociateRouteTable
readList :: ReadS [DisassociateRouteTable]
$creadList :: ReadS [DisassociateRouteTable]
readsPrec :: Int -> ReadS DisassociateRouteTable
$creadsPrec :: Int -> ReadS DisassociateRouteTable
Prelude.Read, Int -> DisassociateRouteTable -> ShowS
[DisassociateRouteTable] -> ShowS
DisassociateRouteTable -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DisassociateRouteTable] -> ShowS
$cshowList :: [DisassociateRouteTable] -> ShowS
show :: DisassociateRouteTable -> String
$cshow :: DisassociateRouteTable -> String
showsPrec :: Int -> DisassociateRouteTable -> ShowS
$cshowsPrec :: Int -> DisassociateRouteTable -> ShowS
Prelude.Show, forall x. Rep DisassociateRouteTable x -> DisassociateRouteTable
forall x. DisassociateRouteTable -> Rep DisassociateRouteTable x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep DisassociateRouteTable x -> DisassociateRouteTable
$cfrom :: forall x. DisassociateRouteTable -> Rep DisassociateRouteTable x
Prelude.Generic)

-- |
-- Create a value of 'DisassociateRouteTable' 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', 'disassociateRouteTable_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', 'disassociateRouteTable_associationId' - The association ID representing the current association between the
-- route table and subnet or gateway.
newDisassociateRouteTable ::
  -- | 'associationId'
  Prelude.Text ->
  DisassociateRouteTable
newDisassociateRouteTable :: Text -> DisassociateRouteTable
newDisassociateRouteTable Text
pAssociationId_ =
  DisassociateRouteTable'
    { $sel:dryRun:DisassociateRouteTable' :: Maybe Bool
dryRun = forall a. Maybe a
Prelude.Nothing,
      $sel:associationId:DisassociateRouteTable' :: Text
associationId = Text
pAssociationId_
    }

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

-- | The association ID representing the current association between the
-- route table and subnet or gateway.
disassociateRouteTable_associationId :: Lens.Lens' DisassociateRouteTable Prelude.Text
disassociateRouteTable_associationId :: Lens' DisassociateRouteTable Text
disassociateRouteTable_associationId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DisassociateRouteTable' {Text
associationId :: Text
$sel:associationId:DisassociateRouteTable' :: DisassociateRouteTable -> Text
associationId} -> Text
associationId) (\s :: DisassociateRouteTable
s@DisassociateRouteTable' {} Text
a -> DisassociateRouteTable
s {$sel:associationId:DisassociateRouteTable' :: Text
associationId = Text
a} :: DisassociateRouteTable)

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

instance Prelude.Hashable DisassociateRouteTable where
  hashWithSalt :: Int -> DisassociateRouteTable -> Int
hashWithSalt Int
_salt DisassociateRouteTable' {Maybe Bool
Text
associationId :: Text
dryRun :: Maybe Bool
$sel:associationId:DisassociateRouteTable' :: DisassociateRouteTable -> Text
$sel:dryRun:DisassociateRouteTable' :: DisassociateRouteTable -> 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

instance Prelude.NFData DisassociateRouteTable where
  rnf :: DisassociateRouteTable -> ()
rnf DisassociateRouteTable' {Maybe Bool
Text
associationId :: Text
dryRun :: Maybe Bool
$sel:associationId:DisassociateRouteTable' :: DisassociateRouteTable -> Text
$sel:dryRun:DisassociateRouteTable' :: DisassociateRouteTable -> 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

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

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

instance Data.ToQuery DisassociateRouteTable where
  toQuery :: DisassociateRouteTable -> QueryString
toQuery DisassociateRouteTable' {Maybe Bool
Text
associationId :: Text
dryRun :: Maybe Bool
$sel:associationId:DisassociateRouteTable' :: DisassociateRouteTable -> Text
$sel:dryRun:DisassociateRouteTable' :: DisassociateRouteTable -> Maybe Bool
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"Action"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: (ByteString
"DisassociateRouteTable" :: 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
      ]

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

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

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