{-# 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.DisassociateTransitGatewayPolicyTable
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Removes the association between an an attachment and a policy table.
module Amazonka.EC2.DisassociateTransitGatewayPolicyTable
  ( -- * Creating a Request
    DisassociateTransitGatewayPolicyTable (..),
    newDisassociateTransitGatewayPolicyTable,

    -- * Request Lenses
    disassociateTransitGatewayPolicyTable_dryRun,
    disassociateTransitGatewayPolicyTable_transitGatewayPolicyTableId,
    disassociateTransitGatewayPolicyTable_transitGatewayAttachmentId,

    -- * Destructuring the Response
    DisassociateTransitGatewayPolicyTableResponse (..),
    newDisassociateTransitGatewayPolicyTableResponse,

    -- * Response Lenses
    disassociateTransitGatewayPolicyTableResponse_association,
    disassociateTransitGatewayPolicyTableResponse_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:/ 'newDisassociateTransitGatewayPolicyTable' smart constructor.
data DisassociateTransitGatewayPolicyTable = DisassociateTransitGatewayPolicyTable'
  { -- | 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@.
    DisassociateTransitGatewayPolicyTable -> Maybe Bool
dryRun :: Prelude.Maybe Prelude.Bool,
    -- | The ID of the disassociated policy table.
    DisassociateTransitGatewayPolicyTable -> Text
transitGatewayPolicyTableId :: Prelude.Text,
    -- | The ID of the transit gateway attachment to disassociate from the policy
    -- table.
    DisassociateTransitGatewayPolicyTable -> Text
transitGatewayAttachmentId :: Prelude.Text
  }
  deriving (DisassociateTransitGatewayPolicyTable
-> DisassociateTransitGatewayPolicyTable -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DisassociateTransitGatewayPolicyTable
-> DisassociateTransitGatewayPolicyTable -> Bool
$c/= :: DisassociateTransitGatewayPolicyTable
-> DisassociateTransitGatewayPolicyTable -> Bool
== :: DisassociateTransitGatewayPolicyTable
-> DisassociateTransitGatewayPolicyTable -> Bool
$c== :: DisassociateTransitGatewayPolicyTable
-> DisassociateTransitGatewayPolicyTable -> Bool
Prelude.Eq, ReadPrec [DisassociateTransitGatewayPolicyTable]
ReadPrec DisassociateTransitGatewayPolicyTable
Int -> ReadS DisassociateTransitGatewayPolicyTable
ReadS [DisassociateTransitGatewayPolicyTable]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DisassociateTransitGatewayPolicyTable]
$creadListPrec :: ReadPrec [DisassociateTransitGatewayPolicyTable]
readPrec :: ReadPrec DisassociateTransitGatewayPolicyTable
$creadPrec :: ReadPrec DisassociateTransitGatewayPolicyTable
readList :: ReadS [DisassociateTransitGatewayPolicyTable]
$creadList :: ReadS [DisassociateTransitGatewayPolicyTable]
readsPrec :: Int -> ReadS DisassociateTransitGatewayPolicyTable
$creadsPrec :: Int -> ReadS DisassociateTransitGatewayPolicyTable
Prelude.Read, Int -> DisassociateTransitGatewayPolicyTable -> ShowS
[DisassociateTransitGatewayPolicyTable] -> ShowS
DisassociateTransitGatewayPolicyTable -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DisassociateTransitGatewayPolicyTable] -> ShowS
$cshowList :: [DisassociateTransitGatewayPolicyTable] -> ShowS
show :: DisassociateTransitGatewayPolicyTable -> String
$cshow :: DisassociateTransitGatewayPolicyTable -> String
showsPrec :: Int -> DisassociateTransitGatewayPolicyTable -> ShowS
$cshowsPrec :: Int -> DisassociateTransitGatewayPolicyTable -> ShowS
Prelude.Show, forall x.
Rep DisassociateTransitGatewayPolicyTable x
-> DisassociateTransitGatewayPolicyTable
forall x.
DisassociateTransitGatewayPolicyTable
-> Rep DisassociateTransitGatewayPolicyTable x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep DisassociateTransitGatewayPolicyTable x
-> DisassociateTransitGatewayPolicyTable
$cfrom :: forall x.
DisassociateTransitGatewayPolicyTable
-> Rep DisassociateTransitGatewayPolicyTable x
Prelude.Generic)

-- |
-- Create a value of 'DisassociateTransitGatewayPolicyTable' 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', 'disassociateTransitGatewayPolicyTable_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@.
--
-- 'transitGatewayPolicyTableId', 'disassociateTransitGatewayPolicyTable_transitGatewayPolicyTableId' - The ID of the disassociated policy table.
--
-- 'transitGatewayAttachmentId', 'disassociateTransitGatewayPolicyTable_transitGatewayAttachmentId' - The ID of the transit gateway attachment to disassociate from the policy
-- table.
newDisassociateTransitGatewayPolicyTable ::
  -- | 'transitGatewayPolicyTableId'
  Prelude.Text ->
  -- | 'transitGatewayAttachmentId'
  Prelude.Text ->
  DisassociateTransitGatewayPolicyTable
newDisassociateTransitGatewayPolicyTable :: Text -> Text -> DisassociateTransitGatewayPolicyTable
newDisassociateTransitGatewayPolicyTable
  Text
pTransitGatewayPolicyTableId_
  Text
pTransitGatewayAttachmentId_ =
    DisassociateTransitGatewayPolicyTable'
      { $sel:dryRun:DisassociateTransitGatewayPolicyTable' :: Maybe Bool
dryRun =
          forall a. Maybe a
Prelude.Nothing,
        $sel:transitGatewayPolicyTableId:DisassociateTransitGatewayPolicyTable' :: Text
transitGatewayPolicyTableId =
          Text
pTransitGatewayPolicyTableId_,
        $sel:transitGatewayAttachmentId:DisassociateTransitGatewayPolicyTable' :: Text
transitGatewayAttachmentId =
          Text
pTransitGatewayAttachmentId_
      }

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

-- | The ID of the disassociated policy table.
disassociateTransitGatewayPolicyTable_transitGatewayPolicyTableId :: Lens.Lens' DisassociateTransitGatewayPolicyTable Prelude.Text
disassociateTransitGatewayPolicyTable_transitGatewayPolicyTableId :: Lens' DisassociateTransitGatewayPolicyTable Text
disassociateTransitGatewayPolicyTable_transitGatewayPolicyTableId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DisassociateTransitGatewayPolicyTable' {Text
transitGatewayPolicyTableId :: Text
$sel:transitGatewayPolicyTableId:DisassociateTransitGatewayPolicyTable' :: DisassociateTransitGatewayPolicyTable -> Text
transitGatewayPolicyTableId} -> Text
transitGatewayPolicyTableId) (\s :: DisassociateTransitGatewayPolicyTable
s@DisassociateTransitGatewayPolicyTable' {} Text
a -> DisassociateTransitGatewayPolicyTable
s {$sel:transitGatewayPolicyTableId:DisassociateTransitGatewayPolicyTable' :: Text
transitGatewayPolicyTableId = Text
a} :: DisassociateTransitGatewayPolicyTable)

-- | The ID of the transit gateway attachment to disassociate from the policy
-- table.
disassociateTransitGatewayPolicyTable_transitGatewayAttachmentId :: Lens.Lens' DisassociateTransitGatewayPolicyTable Prelude.Text
disassociateTransitGatewayPolicyTable_transitGatewayAttachmentId :: Lens' DisassociateTransitGatewayPolicyTable Text
disassociateTransitGatewayPolicyTable_transitGatewayAttachmentId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DisassociateTransitGatewayPolicyTable' {Text
transitGatewayAttachmentId :: Text
$sel:transitGatewayAttachmentId:DisassociateTransitGatewayPolicyTable' :: DisassociateTransitGatewayPolicyTable -> Text
transitGatewayAttachmentId} -> Text
transitGatewayAttachmentId) (\s :: DisassociateTransitGatewayPolicyTable
s@DisassociateTransitGatewayPolicyTable' {} Text
a -> DisassociateTransitGatewayPolicyTable
s {$sel:transitGatewayAttachmentId:DisassociateTransitGatewayPolicyTable' :: Text
transitGatewayAttachmentId = Text
a} :: DisassociateTransitGatewayPolicyTable)

instance
  Core.AWSRequest
    DisassociateTransitGatewayPolicyTable
  where
  type
    AWSResponse
      DisassociateTransitGatewayPolicyTable =
      DisassociateTransitGatewayPolicyTableResponse
  request :: (Service -> Service)
-> DisassociateTransitGatewayPolicyTable
-> Request DisassociateTransitGatewayPolicyTable
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 DisassociateTransitGatewayPolicyTable
-> ClientResponse ClientBody
-> m (Either
        Error
        (ClientResponse
           (AWSResponse DisassociateTransitGatewayPolicyTable)))
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 TransitGatewayPolicyTableAssociation
-> Int -> DisassociateTransitGatewayPolicyTableResponse
DisassociateTransitGatewayPolicyTableResponse'
            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
"association")
            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
    DisassociateTransitGatewayPolicyTable
  where
  hashWithSalt :: Int -> DisassociateTransitGatewayPolicyTable -> Int
hashWithSalt
    Int
_salt
    DisassociateTransitGatewayPolicyTable' {Maybe Bool
Text
transitGatewayAttachmentId :: Text
transitGatewayPolicyTableId :: Text
dryRun :: Maybe Bool
$sel:transitGatewayAttachmentId:DisassociateTransitGatewayPolicyTable' :: DisassociateTransitGatewayPolicyTable -> Text
$sel:transitGatewayPolicyTableId:DisassociateTransitGatewayPolicyTable' :: DisassociateTransitGatewayPolicyTable -> Text
$sel:dryRun:DisassociateTransitGatewayPolicyTable' :: DisassociateTransitGatewayPolicyTable -> 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
transitGatewayPolicyTableId
        forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
transitGatewayAttachmentId

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

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

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

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

-- | /See:/ 'newDisassociateTransitGatewayPolicyTableResponse' smart constructor.
data DisassociateTransitGatewayPolicyTableResponse = DisassociateTransitGatewayPolicyTableResponse'
  { -- | Returns details about the transit gateway policy table disassociation.
    DisassociateTransitGatewayPolicyTableResponse
-> Maybe TransitGatewayPolicyTableAssociation
association :: Prelude.Maybe TransitGatewayPolicyTableAssociation,
    -- | The response's http status code.
    DisassociateTransitGatewayPolicyTableResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (DisassociateTransitGatewayPolicyTableResponse
-> DisassociateTransitGatewayPolicyTableResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DisassociateTransitGatewayPolicyTableResponse
-> DisassociateTransitGatewayPolicyTableResponse -> Bool
$c/= :: DisassociateTransitGatewayPolicyTableResponse
-> DisassociateTransitGatewayPolicyTableResponse -> Bool
== :: DisassociateTransitGatewayPolicyTableResponse
-> DisassociateTransitGatewayPolicyTableResponse -> Bool
$c== :: DisassociateTransitGatewayPolicyTableResponse
-> DisassociateTransitGatewayPolicyTableResponse -> Bool
Prelude.Eq, ReadPrec [DisassociateTransitGatewayPolicyTableResponse]
ReadPrec DisassociateTransitGatewayPolicyTableResponse
Int -> ReadS DisassociateTransitGatewayPolicyTableResponse
ReadS [DisassociateTransitGatewayPolicyTableResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DisassociateTransitGatewayPolicyTableResponse]
$creadListPrec :: ReadPrec [DisassociateTransitGatewayPolicyTableResponse]
readPrec :: ReadPrec DisassociateTransitGatewayPolicyTableResponse
$creadPrec :: ReadPrec DisassociateTransitGatewayPolicyTableResponse
readList :: ReadS [DisassociateTransitGatewayPolicyTableResponse]
$creadList :: ReadS [DisassociateTransitGatewayPolicyTableResponse]
readsPrec :: Int -> ReadS DisassociateTransitGatewayPolicyTableResponse
$creadsPrec :: Int -> ReadS DisassociateTransitGatewayPolicyTableResponse
Prelude.Read, Int -> DisassociateTransitGatewayPolicyTableResponse -> ShowS
[DisassociateTransitGatewayPolicyTableResponse] -> ShowS
DisassociateTransitGatewayPolicyTableResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DisassociateTransitGatewayPolicyTableResponse] -> ShowS
$cshowList :: [DisassociateTransitGatewayPolicyTableResponse] -> ShowS
show :: DisassociateTransitGatewayPolicyTableResponse -> String
$cshow :: DisassociateTransitGatewayPolicyTableResponse -> String
showsPrec :: Int -> DisassociateTransitGatewayPolicyTableResponse -> ShowS
$cshowsPrec :: Int -> DisassociateTransitGatewayPolicyTableResponse -> ShowS
Prelude.Show, forall x.
Rep DisassociateTransitGatewayPolicyTableResponse x
-> DisassociateTransitGatewayPolicyTableResponse
forall x.
DisassociateTransitGatewayPolicyTableResponse
-> Rep DisassociateTransitGatewayPolicyTableResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep DisassociateTransitGatewayPolicyTableResponse x
-> DisassociateTransitGatewayPolicyTableResponse
$cfrom :: forall x.
DisassociateTransitGatewayPolicyTableResponse
-> Rep DisassociateTransitGatewayPolicyTableResponse x
Prelude.Generic)

-- |
-- Create a value of 'DisassociateTransitGatewayPolicyTableResponse' 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:
--
-- 'association', 'disassociateTransitGatewayPolicyTableResponse_association' - Returns details about the transit gateway policy table disassociation.
--
-- 'httpStatus', 'disassociateTransitGatewayPolicyTableResponse_httpStatus' - The response's http status code.
newDisassociateTransitGatewayPolicyTableResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  DisassociateTransitGatewayPolicyTableResponse
newDisassociateTransitGatewayPolicyTableResponse :: Int -> DisassociateTransitGatewayPolicyTableResponse
newDisassociateTransitGatewayPolicyTableResponse
  Int
pHttpStatus_ =
    DisassociateTransitGatewayPolicyTableResponse'
      { $sel:association:DisassociateTransitGatewayPolicyTableResponse' :: Maybe TransitGatewayPolicyTableAssociation
association =
          forall a. Maybe a
Prelude.Nothing,
        $sel:httpStatus:DisassociateTransitGatewayPolicyTableResponse' :: Int
httpStatus = Int
pHttpStatus_
      }

-- | Returns details about the transit gateway policy table disassociation.
disassociateTransitGatewayPolicyTableResponse_association :: Lens.Lens' DisassociateTransitGatewayPolicyTableResponse (Prelude.Maybe TransitGatewayPolicyTableAssociation)
disassociateTransitGatewayPolicyTableResponse_association :: Lens'
  DisassociateTransitGatewayPolicyTableResponse
  (Maybe TransitGatewayPolicyTableAssociation)
disassociateTransitGatewayPolicyTableResponse_association = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DisassociateTransitGatewayPolicyTableResponse' {Maybe TransitGatewayPolicyTableAssociation
association :: Maybe TransitGatewayPolicyTableAssociation
$sel:association:DisassociateTransitGatewayPolicyTableResponse' :: DisassociateTransitGatewayPolicyTableResponse
-> Maybe TransitGatewayPolicyTableAssociation
association} -> Maybe TransitGatewayPolicyTableAssociation
association) (\s :: DisassociateTransitGatewayPolicyTableResponse
s@DisassociateTransitGatewayPolicyTableResponse' {} Maybe TransitGatewayPolicyTableAssociation
a -> DisassociateTransitGatewayPolicyTableResponse
s {$sel:association:DisassociateTransitGatewayPolicyTableResponse' :: Maybe TransitGatewayPolicyTableAssociation
association = Maybe TransitGatewayPolicyTableAssociation
a} :: DisassociateTransitGatewayPolicyTableResponse)

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

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