{-# 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.CreateTransitGatewayPolicyTable
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Creates a transit gateway policy table.
module Amazonka.EC2.CreateTransitGatewayPolicyTable
  ( -- * Creating a Request
    CreateTransitGatewayPolicyTable (..),
    newCreateTransitGatewayPolicyTable,

    -- * Request Lenses
    createTransitGatewayPolicyTable_dryRun,
    createTransitGatewayPolicyTable_tagSpecifications,
    createTransitGatewayPolicyTable_transitGatewayId,

    -- * Destructuring the Response
    CreateTransitGatewayPolicyTableResponse (..),
    newCreateTransitGatewayPolicyTableResponse,

    -- * Response Lenses
    createTransitGatewayPolicyTableResponse_transitGatewayPolicyTable,
    createTransitGatewayPolicyTableResponse_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:/ 'newCreateTransitGatewayPolicyTable' smart constructor.
data CreateTransitGatewayPolicyTable = CreateTransitGatewayPolicyTable'
  { -- | 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@.
    CreateTransitGatewayPolicyTable -> Maybe Bool
dryRun :: Prelude.Maybe Prelude.Bool,
    -- | The tags specification for the transit gateway policy table created
    -- during the request.
    CreateTransitGatewayPolicyTable -> Maybe [TagSpecification]
tagSpecifications :: Prelude.Maybe [TagSpecification],
    -- | The ID of the transit gateway used for the policy table.
    CreateTransitGatewayPolicyTable -> Text
transitGatewayId :: Prelude.Text
  }
  deriving (CreateTransitGatewayPolicyTable
-> CreateTransitGatewayPolicyTable -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateTransitGatewayPolicyTable
-> CreateTransitGatewayPolicyTable -> Bool
$c/= :: CreateTransitGatewayPolicyTable
-> CreateTransitGatewayPolicyTable -> Bool
== :: CreateTransitGatewayPolicyTable
-> CreateTransitGatewayPolicyTable -> Bool
$c== :: CreateTransitGatewayPolicyTable
-> CreateTransitGatewayPolicyTable -> Bool
Prelude.Eq, ReadPrec [CreateTransitGatewayPolicyTable]
ReadPrec CreateTransitGatewayPolicyTable
Int -> ReadS CreateTransitGatewayPolicyTable
ReadS [CreateTransitGatewayPolicyTable]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CreateTransitGatewayPolicyTable]
$creadListPrec :: ReadPrec [CreateTransitGatewayPolicyTable]
readPrec :: ReadPrec CreateTransitGatewayPolicyTable
$creadPrec :: ReadPrec CreateTransitGatewayPolicyTable
readList :: ReadS [CreateTransitGatewayPolicyTable]
$creadList :: ReadS [CreateTransitGatewayPolicyTable]
readsPrec :: Int -> ReadS CreateTransitGatewayPolicyTable
$creadsPrec :: Int -> ReadS CreateTransitGatewayPolicyTable
Prelude.Read, Int -> CreateTransitGatewayPolicyTable -> ShowS
[CreateTransitGatewayPolicyTable] -> ShowS
CreateTransitGatewayPolicyTable -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateTransitGatewayPolicyTable] -> ShowS
$cshowList :: [CreateTransitGatewayPolicyTable] -> ShowS
show :: CreateTransitGatewayPolicyTable -> String
$cshow :: CreateTransitGatewayPolicyTable -> String
showsPrec :: Int -> CreateTransitGatewayPolicyTable -> ShowS
$cshowsPrec :: Int -> CreateTransitGatewayPolicyTable -> ShowS
Prelude.Show, forall x.
Rep CreateTransitGatewayPolicyTable x
-> CreateTransitGatewayPolicyTable
forall x.
CreateTransitGatewayPolicyTable
-> Rep CreateTransitGatewayPolicyTable x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep CreateTransitGatewayPolicyTable x
-> CreateTransitGatewayPolicyTable
$cfrom :: forall x.
CreateTransitGatewayPolicyTable
-> Rep CreateTransitGatewayPolicyTable x
Prelude.Generic)

-- |
-- Create a value of 'CreateTransitGatewayPolicyTable' 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', 'createTransitGatewayPolicyTable_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@.
--
-- 'tagSpecifications', 'createTransitGatewayPolicyTable_tagSpecifications' - The tags specification for the transit gateway policy table created
-- during the request.
--
-- 'transitGatewayId', 'createTransitGatewayPolicyTable_transitGatewayId' - The ID of the transit gateway used for the policy table.
newCreateTransitGatewayPolicyTable ::
  -- | 'transitGatewayId'
  Prelude.Text ->
  CreateTransitGatewayPolicyTable
newCreateTransitGatewayPolicyTable :: Text -> CreateTransitGatewayPolicyTable
newCreateTransitGatewayPolicyTable Text
pTransitGatewayId_ =
  CreateTransitGatewayPolicyTable'
    { $sel:dryRun:CreateTransitGatewayPolicyTable' :: Maybe Bool
dryRun =
        forall a. Maybe a
Prelude.Nothing,
      $sel:tagSpecifications:CreateTransitGatewayPolicyTable' :: Maybe [TagSpecification]
tagSpecifications = forall a. Maybe a
Prelude.Nothing,
      $sel:transitGatewayId:CreateTransitGatewayPolicyTable' :: Text
transitGatewayId = Text
pTransitGatewayId_
    }

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

-- | The tags specification for the transit gateway policy table created
-- during the request.
createTransitGatewayPolicyTable_tagSpecifications :: Lens.Lens' CreateTransitGatewayPolicyTable (Prelude.Maybe [TagSpecification])
createTransitGatewayPolicyTable_tagSpecifications :: Lens' CreateTransitGatewayPolicyTable (Maybe [TagSpecification])
createTransitGatewayPolicyTable_tagSpecifications = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateTransitGatewayPolicyTable' {Maybe [TagSpecification]
tagSpecifications :: Maybe [TagSpecification]
$sel:tagSpecifications:CreateTransitGatewayPolicyTable' :: CreateTransitGatewayPolicyTable -> Maybe [TagSpecification]
tagSpecifications} -> Maybe [TagSpecification]
tagSpecifications) (\s :: CreateTransitGatewayPolicyTable
s@CreateTransitGatewayPolicyTable' {} Maybe [TagSpecification]
a -> CreateTransitGatewayPolicyTable
s {$sel:tagSpecifications:CreateTransitGatewayPolicyTable' :: Maybe [TagSpecification]
tagSpecifications = Maybe [TagSpecification]
a} :: CreateTransitGatewayPolicyTable) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall (f :: * -> *) (g :: * -> *) s t a b.
(Functor f, Functor g) =>
AnIso s t a b -> Iso (f s) (g t) (f a) (g b)
Lens.mapping forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Lens.coerced

-- | The ID of the transit gateway used for the policy table.
createTransitGatewayPolicyTable_transitGatewayId :: Lens.Lens' CreateTransitGatewayPolicyTable Prelude.Text
createTransitGatewayPolicyTable_transitGatewayId :: Lens' CreateTransitGatewayPolicyTable Text
createTransitGatewayPolicyTable_transitGatewayId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateTransitGatewayPolicyTable' {Text
transitGatewayId :: Text
$sel:transitGatewayId:CreateTransitGatewayPolicyTable' :: CreateTransitGatewayPolicyTable -> Text
transitGatewayId} -> Text
transitGatewayId) (\s :: CreateTransitGatewayPolicyTable
s@CreateTransitGatewayPolicyTable' {} Text
a -> CreateTransitGatewayPolicyTable
s {$sel:transitGatewayId:CreateTransitGatewayPolicyTable' :: Text
transitGatewayId = Text
a} :: CreateTransitGatewayPolicyTable)

instance
  Core.AWSRequest
    CreateTransitGatewayPolicyTable
  where
  type
    AWSResponse CreateTransitGatewayPolicyTable =
      CreateTransitGatewayPolicyTableResponse
  request :: (Service -> Service)
-> CreateTransitGatewayPolicyTable
-> Request CreateTransitGatewayPolicyTable
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 CreateTransitGatewayPolicyTable
-> ClientResponse ClientBody
-> m (Either
        Error
        (ClientResponse (AWSResponse CreateTransitGatewayPolicyTable)))
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 TransitGatewayPolicyTable
-> Int -> CreateTransitGatewayPolicyTableResponse
CreateTransitGatewayPolicyTableResponse'
            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
"transitGatewayPolicyTable")
            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
    CreateTransitGatewayPolicyTable
  where
  hashWithSalt :: Int -> CreateTransitGatewayPolicyTable -> Int
hashWithSalt
    Int
_salt
    CreateTransitGatewayPolicyTable' {Maybe Bool
Maybe [TagSpecification]
Text
transitGatewayId :: Text
tagSpecifications :: Maybe [TagSpecification]
dryRun :: Maybe Bool
$sel:transitGatewayId:CreateTransitGatewayPolicyTable' :: CreateTransitGatewayPolicyTable -> Text
$sel:tagSpecifications:CreateTransitGatewayPolicyTable' :: CreateTransitGatewayPolicyTable -> Maybe [TagSpecification]
$sel:dryRun:CreateTransitGatewayPolicyTable' :: CreateTransitGatewayPolicyTable -> 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` Maybe [TagSpecification]
tagSpecifications
        forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
transitGatewayId

instance
  Prelude.NFData
    CreateTransitGatewayPolicyTable
  where
  rnf :: CreateTransitGatewayPolicyTable -> ()
rnf CreateTransitGatewayPolicyTable' {Maybe Bool
Maybe [TagSpecification]
Text
transitGatewayId :: Text
tagSpecifications :: Maybe [TagSpecification]
dryRun :: Maybe Bool
$sel:transitGatewayId:CreateTransitGatewayPolicyTable' :: CreateTransitGatewayPolicyTable -> Text
$sel:tagSpecifications:CreateTransitGatewayPolicyTable' :: CreateTransitGatewayPolicyTable -> Maybe [TagSpecification]
$sel:dryRun:CreateTransitGatewayPolicyTable' :: CreateTransitGatewayPolicyTable -> 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 Maybe [TagSpecification]
tagSpecifications
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
transitGatewayId

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

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

instance Data.ToQuery CreateTransitGatewayPolicyTable where
  toQuery :: CreateTransitGatewayPolicyTable -> QueryString
toQuery CreateTransitGatewayPolicyTable' {Maybe Bool
Maybe [TagSpecification]
Text
transitGatewayId :: Text
tagSpecifications :: Maybe [TagSpecification]
dryRun :: Maybe Bool
$sel:transitGatewayId:CreateTransitGatewayPolicyTable' :: CreateTransitGatewayPolicyTable -> Text
$sel:tagSpecifications:CreateTransitGatewayPolicyTable' :: CreateTransitGatewayPolicyTable -> Maybe [TagSpecification]
$sel:dryRun:CreateTransitGatewayPolicyTable' :: CreateTransitGatewayPolicyTable -> Maybe Bool
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"Action"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: ( ByteString
"CreateTransitGatewayPolicyTable" ::
                      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,
        forall a. ToQuery a => a -> QueryString
Data.toQuery
          ( forall a.
(IsList a, ToQuery (Item a)) =>
ByteString -> a -> QueryString
Data.toQueryList ByteString
"TagSpecifications"
              forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe [TagSpecification]
tagSpecifications
          ),
        ByteString
"TransitGatewayId" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Text
transitGatewayId
      ]

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

-- |
-- Create a value of 'CreateTransitGatewayPolicyTableResponse' 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:
--
-- 'transitGatewayPolicyTable', 'createTransitGatewayPolicyTableResponse_transitGatewayPolicyTable' - Describes the created transit gateway policy table.
--
-- 'httpStatus', 'createTransitGatewayPolicyTableResponse_httpStatus' - The response's http status code.
newCreateTransitGatewayPolicyTableResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  CreateTransitGatewayPolicyTableResponse
newCreateTransitGatewayPolicyTableResponse :: Int -> CreateTransitGatewayPolicyTableResponse
newCreateTransitGatewayPolicyTableResponse
  Int
pHttpStatus_ =
    CreateTransitGatewayPolicyTableResponse'
      { $sel:transitGatewayPolicyTable:CreateTransitGatewayPolicyTableResponse' :: Maybe TransitGatewayPolicyTable
transitGatewayPolicyTable =
          forall a. Maybe a
Prelude.Nothing,
        $sel:httpStatus:CreateTransitGatewayPolicyTableResponse' :: Int
httpStatus = Int
pHttpStatus_
      }

-- | Describes the created transit gateway policy table.
createTransitGatewayPolicyTableResponse_transitGatewayPolicyTable :: Lens.Lens' CreateTransitGatewayPolicyTableResponse (Prelude.Maybe TransitGatewayPolicyTable)
createTransitGatewayPolicyTableResponse_transitGatewayPolicyTable :: Lens'
  CreateTransitGatewayPolicyTableResponse
  (Maybe TransitGatewayPolicyTable)
createTransitGatewayPolicyTableResponse_transitGatewayPolicyTable = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateTransitGatewayPolicyTableResponse' {Maybe TransitGatewayPolicyTable
transitGatewayPolicyTable :: Maybe TransitGatewayPolicyTable
$sel:transitGatewayPolicyTable:CreateTransitGatewayPolicyTableResponse' :: CreateTransitGatewayPolicyTableResponse
-> Maybe TransitGatewayPolicyTable
transitGatewayPolicyTable} -> Maybe TransitGatewayPolicyTable
transitGatewayPolicyTable) (\s :: CreateTransitGatewayPolicyTableResponse
s@CreateTransitGatewayPolicyTableResponse' {} Maybe TransitGatewayPolicyTable
a -> CreateTransitGatewayPolicyTableResponse
s {$sel:transitGatewayPolicyTable:CreateTransitGatewayPolicyTableResponse' :: Maybe TransitGatewayPolicyTable
transitGatewayPolicyTable = Maybe TransitGatewayPolicyTable
a} :: CreateTransitGatewayPolicyTableResponse)

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

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