{-# 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.CreateTransitGatewayRouteTable
-- 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 route table for the specified transit gateway.
module Amazonka.EC2.CreateTransitGatewayRouteTable
  ( -- * Creating a Request
    CreateTransitGatewayRouteTable (..),
    newCreateTransitGatewayRouteTable,

    -- * Request Lenses
    createTransitGatewayRouteTable_dryRun,
    createTransitGatewayRouteTable_tagSpecifications,
    createTransitGatewayRouteTable_transitGatewayId,

    -- * Destructuring the Response
    CreateTransitGatewayRouteTableResponse (..),
    newCreateTransitGatewayRouteTableResponse,

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

-- |
-- Create a value of 'CreateTransitGatewayRouteTable' 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', 'createTransitGatewayRouteTable_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', 'createTransitGatewayRouteTable_tagSpecifications' - The tags to apply to the transit gateway route table.
--
-- 'transitGatewayId', 'createTransitGatewayRouteTable_transitGatewayId' - The ID of the transit gateway.
newCreateTransitGatewayRouteTable ::
  -- | 'transitGatewayId'
  Prelude.Text ->
  CreateTransitGatewayRouteTable
newCreateTransitGatewayRouteTable :: Text -> CreateTransitGatewayRouteTable
newCreateTransitGatewayRouteTable Text
pTransitGatewayId_ =
  CreateTransitGatewayRouteTable'
    { $sel:dryRun:CreateTransitGatewayRouteTable' :: Maybe Bool
dryRun =
        forall a. Maybe a
Prelude.Nothing,
      $sel:tagSpecifications:CreateTransitGatewayRouteTable' :: Maybe [TagSpecification]
tagSpecifications = forall a. Maybe a
Prelude.Nothing,
      $sel:transitGatewayId:CreateTransitGatewayRouteTable' :: 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@.
createTransitGatewayRouteTable_dryRun :: Lens.Lens' CreateTransitGatewayRouteTable (Prelude.Maybe Prelude.Bool)
createTransitGatewayRouteTable_dryRun :: Lens' CreateTransitGatewayRouteTable (Maybe Bool)
createTransitGatewayRouteTable_dryRun = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateTransitGatewayRouteTable' {Maybe Bool
dryRun :: Maybe Bool
$sel:dryRun:CreateTransitGatewayRouteTable' :: CreateTransitGatewayRouteTable -> Maybe Bool
dryRun} -> Maybe Bool
dryRun) (\s :: CreateTransitGatewayRouteTable
s@CreateTransitGatewayRouteTable' {} Maybe Bool
a -> CreateTransitGatewayRouteTable
s {$sel:dryRun:CreateTransitGatewayRouteTable' :: Maybe Bool
dryRun = Maybe Bool
a} :: CreateTransitGatewayRouteTable)

-- | The tags to apply to the transit gateway route table.
createTransitGatewayRouteTable_tagSpecifications :: Lens.Lens' CreateTransitGatewayRouteTable (Prelude.Maybe [TagSpecification])
createTransitGatewayRouteTable_tagSpecifications :: Lens' CreateTransitGatewayRouteTable (Maybe [TagSpecification])
createTransitGatewayRouteTable_tagSpecifications = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateTransitGatewayRouteTable' {Maybe [TagSpecification]
tagSpecifications :: Maybe [TagSpecification]
$sel:tagSpecifications:CreateTransitGatewayRouteTable' :: CreateTransitGatewayRouteTable -> Maybe [TagSpecification]
tagSpecifications} -> Maybe [TagSpecification]
tagSpecifications) (\s :: CreateTransitGatewayRouteTable
s@CreateTransitGatewayRouteTable' {} Maybe [TagSpecification]
a -> CreateTransitGatewayRouteTable
s {$sel:tagSpecifications:CreateTransitGatewayRouteTable' :: Maybe [TagSpecification]
tagSpecifications = Maybe [TagSpecification]
a} :: CreateTransitGatewayRouteTable) 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.
createTransitGatewayRouteTable_transitGatewayId :: Lens.Lens' CreateTransitGatewayRouteTable Prelude.Text
createTransitGatewayRouteTable_transitGatewayId :: Lens' CreateTransitGatewayRouteTable Text
createTransitGatewayRouteTable_transitGatewayId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateTransitGatewayRouteTable' {Text
transitGatewayId :: Text
$sel:transitGatewayId:CreateTransitGatewayRouteTable' :: CreateTransitGatewayRouteTable -> Text
transitGatewayId} -> Text
transitGatewayId) (\s :: CreateTransitGatewayRouteTable
s@CreateTransitGatewayRouteTable' {} Text
a -> CreateTransitGatewayRouteTable
s {$sel:transitGatewayId:CreateTransitGatewayRouteTable' :: Text
transitGatewayId = Text
a} :: CreateTransitGatewayRouteTable)

instance
  Core.AWSRequest
    CreateTransitGatewayRouteTable
  where
  type
    AWSResponse CreateTransitGatewayRouteTable =
      CreateTransitGatewayRouteTableResponse
  request :: (Service -> Service)
-> CreateTransitGatewayRouteTable
-> Request CreateTransitGatewayRouteTable
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 CreateTransitGatewayRouteTable
-> ClientResponse ClientBody
-> m (Either
        Error
        (ClientResponse (AWSResponse CreateTransitGatewayRouteTable)))
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 TransitGatewayRouteTable
-> Int -> CreateTransitGatewayRouteTableResponse
CreateTransitGatewayRouteTableResponse'
            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
"transitGatewayRouteTable")
            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
    CreateTransitGatewayRouteTable
  where
  hashWithSalt :: Int -> CreateTransitGatewayRouteTable -> Int
hashWithSalt
    Int
_salt
    CreateTransitGatewayRouteTable' {Maybe Bool
Maybe [TagSpecification]
Text
transitGatewayId :: Text
tagSpecifications :: Maybe [TagSpecification]
dryRun :: Maybe Bool
$sel:transitGatewayId:CreateTransitGatewayRouteTable' :: CreateTransitGatewayRouteTable -> Text
$sel:tagSpecifications:CreateTransitGatewayRouteTable' :: CreateTransitGatewayRouteTable -> Maybe [TagSpecification]
$sel:dryRun:CreateTransitGatewayRouteTable' :: CreateTransitGatewayRouteTable -> 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
    CreateTransitGatewayRouteTable
  where
  rnf :: CreateTransitGatewayRouteTable -> ()
rnf CreateTransitGatewayRouteTable' {Maybe Bool
Maybe [TagSpecification]
Text
transitGatewayId :: Text
tagSpecifications :: Maybe [TagSpecification]
dryRun :: Maybe Bool
$sel:transitGatewayId:CreateTransitGatewayRouteTable' :: CreateTransitGatewayRouteTable -> Text
$sel:tagSpecifications:CreateTransitGatewayRouteTable' :: CreateTransitGatewayRouteTable -> Maybe [TagSpecification]
$sel:dryRun:CreateTransitGatewayRouteTable' :: CreateTransitGatewayRouteTable -> 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
    CreateTransitGatewayRouteTable
  where
  toHeaders :: CreateTransitGatewayRouteTable -> ResponseHeaders
toHeaders = forall a b. a -> b -> a
Prelude.const forall a. Monoid a => a
Prelude.mempty

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

instance Data.ToQuery CreateTransitGatewayRouteTable where
  toQuery :: CreateTransitGatewayRouteTable -> QueryString
toQuery CreateTransitGatewayRouteTable' {Maybe Bool
Maybe [TagSpecification]
Text
transitGatewayId :: Text
tagSpecifications :: Maybe [TagSpecification]
dryRun :: Maybe Bool
$sel:transitGatewayId:CreateTransitGatewayRouteTable' :: CreateTransitGatewayRouteTable -> Text
$sel:tagSpecifications:CreateTransitGatewayRouteTable' :: CreateTransitGatewayRouteTable -> Maybe [TagSpecification]
$sel:dryRun:CreateTransitGatewayRouteTable' :: CreateTransitGatewayRouteTable -> Maybe Bool
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"Action"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: ( ByteString
"CreateTransitGatewayRouteTable" ::
                      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:/ 'newCreateTransitGatewayRouteTableResponse' smart constructor.
data CreateTransitGatewayRouteTableResponse = CreateTransitGatewayRouteTableResponse'
  { -- | Information about the transit gateway route table.
    CreateTransitGatewayRouteTableResponse
-> Maybe TransitGatewayRouteTable
transitGatewayRouteTable :: Prelude.Maybe TransitGatewayRouteTable,
    -- | The response's http status code.
    CreateTransitGatewayRouteTableResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (CreateTransitGatewayRouteTableResponse
-> CreateTransitGatewayRouteTableResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateTransitGatewayRouteTableResponse
-> CreateTransitGatewayRouteTableResponse -> Bool
$c/= :: CreateTransitGatewayRouteTableResponse
-> CreateTransitGatewayRouteTableResponse -> Bool
== :: CreateTransitGatewayRouteTableResponse
-> CreateTransitGatewayRouteTableResponse -> Bool
$c== :: CreateTransitGatewayRouteTableResponse
-> CreateTransitGatewayRouteTableResponse -> Bool
Prelude.Eq, ReadPrec [CreateTransitGatewayRouteTableResponse]
ReadPrec CreateTransitGatewayRouteTableResponse
Int -> ReadS CreateTransitGatewayRouteTableResponse
ReadS [CreateTransitGatewayRouteTableResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CreateTransitGatewayRouteTableResponse]
$creadListPrec :: ReadPrec [CreateTransitGatewayRouteTableResponse]
readPrec :: ReadPrec CreateTransitGatewayRouteTableResponse
$creadPrec :: ReadPrec CreateTransitGatewayRouteTableResponse
readList :: ReadS [CreateTransitGatewayRouteTableResponse]
$creadList :: ReadS [CreateTransitGatewayRouteTableResponse]
readsPrec :: Int -> ReadS CreateTransitGatewayRouteTableResponse
$creadsPrec :: Int -> ReadS CreateTransitGatewayRouteTableResponse
Prelude.Read, Int -> CreateTransitGatewayRouteTableResponse -> ShowS
[CreateTransitGatewayRouteTableResponse] -> ShowS
CreateTransitGatewayRouteTableResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateTransitGatewayRouteTableResponse] -> ShowS
$cshowList :: [CreateTransitGatewayRouteTableResponse] -> ShowS
show :: CreateTransitGatewayRouteTableResponse -> String
$cshow :: CreateTransitGatewayRouteTableResponse -> String
showsPrec :: Int -> CreateTransitGatewayRouteTableResponse -> ShowS
$cshowsPrec :: Int -> CreateTransitGatewayRouteTableResponse -> ShowS
Prelude.Show, forall x.
Rep CreateTransitGatewayRouteTableResponse x
-> CreateTransitGatewayRouteTableResponse
forall x.
CreateTransitGatewayRouteTableResponse
-> Rep CreateTransitGatewayRouteTableResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep CreateTransitGatewayRouteTableResponse x
-> CreateTransitGatewayRouteTableResponse
$cfrom :: forall x.
CreateTransitGatewayRouteTableResponse
-> Rep CreateTransitGatewayRouteTableResponse x
Prelude.Generic)

-- |
-- Create a value of 'CreateTransitGatewayRouteTableResponse' 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:
--
-- 'transitGatewayRouteTable', 'createTransitGatewayRouteTableResponse_transitGatewayRouteTable' - Information about the transit gateway route table.
--
-- 'httpStatus', 'createTransitGatewayRouteTableResponse_httpStatus' - The response's http status code.
newCreateTransitGatewayRouteTableResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  CreateTransitGatewayRouteTableResponse
newCreateTransitGatewayRouteTableResponse :: Int -> CreateTransitGatewayRouteTableResponse
newCreateTransitGatewayRouteTableResponse
  Int
pHttpStatus_ =
    CreateTransitGatewayRouteTableResponse'
      { $sel:transitGatewayRouteTable:CreateTransitGatewayRouteTableResponse' :: Maybe TransitGatewayRouteTable
transitGatewayRouteTable =
          forall a. Maybe a
Prelude.Nothing,
        $sel:httpStatus:CreateTransitGatewayRouteTableResponse' :: Int
httpStatus = Int
pHttpStatus_
      }

-- | Information about the transit gateway route table.
createTransitGatewayRouteTableResponse_transitGatewayRouteTable :: Lens.Lens' CreateTransitGatewayRouteTableResponse (Prelude.Maybe TransitGatewayRouteTable)
createTransitGatewayRouteTableResponse_transitGatewayRouteTable :: Lens'
  CreateTransitGatewayRouteTableResponse
  (Maybe TransitGatewayRouteTable)
createTransitGatewayRouteTableResponse_transitGatewayRouteTable = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateTransitGatewayRouteTableResponse' {Maybe TransitGatewayRouteTable
transitGatewayRouteTable :: Maybe TransitGatewayRouteTable
$sel:transitGatewayRouteTable:CreateTransitGatewayRouteTableResponse' :: CreateTransitGatewayRouteTableResponse
-> Maybe TransitGatewayRouteTable
transitGatewayRouteTable} -> Maybe TransitGatewayRouteTable
transitGatewayRouteTable) (\s :: CreateTransitGatewayRouteTableResponse
s@CreateTransitGatewayRouteTableResponse' {} Maybe TransitGatewayRouteTable
a -> CreateTransitGatewayRouteTableResponse
s {$sel:transitGatewayRouteTable:CreateTransitGatewayRouteTableResponse' :: Maybe TransitGatewayRouteTable
transitGatewayRouteTable = Maybe TransitGatewayRouteTable
a} :: CreateTransitGatewayRouteTableResponse)

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

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