{-# 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.CreateTransitGateway
-- 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.
--
-- You can use a transit gateway to interconnect your virtual private
-- clouds (VPC) and on-premises networks. After the transit gateway enters
-- the @available@ state, you can attach your VPCs and VPN connections to
-- the transit gateway.
--
-- To attach your VPCs, use CreateTransitGatewayVpcAttachment.
--
-- To attach a VPN connection, use CreateCustomerGateway to create a
-- customer gateway and specify the ID of the customer gateway and the ID
-- of the transit gateway in a call to CreateVpnConnection.
--
-- When you create a transit gateway, we create a default transit gateway
-- route table and use it as the default association route table and the
-- default propagation route table. You can use
-- CreateTransitGatewayRouteTable to create additional transit gateway
-- route tables. If you disable automatic route propagation, we do not
-- create a default transit gateway route table. You can use
-- EnableTransitGatewayRouteTablePropagation to propagate routes from a
-- resource attachment to a transit gateway route table. If you disable
-- automatic associations, you can use AssociateTransitGatewayRouteTable to
-- associate a resource attachment with a transit gateway route table.
module Amazonka.EC2.CreateTransitGateway
  ( -- * Creating a Request
    CreateTransitGateway (..),
    newCreateTransitGateway,

    -- * Request Lenses
    createTransitGateway_description,
    createTransitGateway_dryRun,
    createTransitGateway_options,
    createTransitGateway_tagSpecifications,

    -- * Destructuring the Response
    CreateTransitGatewayResponse (..),
    newCreateTransitGatewayResponse,

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

-- |
-- Create a value of 'CreateTransitGateway' 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:
--
-- 'description', 'createTransitGateway_description' - A description of the transit gateway.
--
-- 'dryRun', 'createTransitGateway_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@.
--
-- 'options', 'createTransitGateway_options' - The transit gateway options.
--
-- 'tagSpecifications', 'createTransitGateway_tagSpecifications' - The tags to apply to the transit gateway.
newCreateTransitGateway ::
  CreateTransitGateway
newCreateTransitGateway :: CreateTransitGateway
newCreateTransitGateway =
  CreateTransitGateway'
    { $sel:description:CreateTransitGateway' :: Maybe Text
description =
        forall a. Maybe a
Prelude.Nothing,
      $sel:dryRun:CreateTransitGateway' :: Maybe Bool
dryRun = forall a. Maybe a
Prelude.Nothing,
      $sel:options:CreateTransitGateway' :: Maybe TransitGatewayRequestOptions
options = forall a. Maybe a
Prelude.Nothing,
      $sel:tagSpecifications:CreateTransitGateway' :: Maybe [TagSpecification]
tagSpecifications = forall a. Maybe a
Prelude.Nothing
    }

-- | A description of the transit gateway.
createTransitGateway_description :: Lens.Lens' CreateTransitGateway (Prelude.Maybe Prelude.Text)
createTransitGateway_description :: Lens' CreateTransitGateway (Maybe Text)
createTransitGateway_description = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateTransitGateway' {Maybe Text
description :: Maybe Text
$sel:description:CreateTransitGateway' :: CreateTransitGateway -> Maybe Text
description} -> Maybe Text
description) (\s :: CreateTransitGateway
s@CreateTransitGateway' {} Maybe Text
a -> CreateTransitGateway
s {$sel:description:CreateTransitGateway' :: Maybe Text
description = Maybe Text
a} :: CreateTransitGateway)

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

-- | The transit gateway options.
createTransitGateway_options :: Lens.Lens' CreateTransitGateway (Prelude.Maybe TransitGatewayRequestOptions)
createTransitGateway_options :: Lens' CreateTransitGateway (Maybe TransitGatewayRequestOptions)
createTransitGateway_options = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateTransitGateway' {Maybe TransitGatewayRequestOptions
options :: Maybe TransitGatewayRequestOptions
$sel:options:CreateTransitGateway' :: CreateTransitGateway -> Maybe TransitGatewayRequestOptions
options} -> Maybe TransitGatewayRequestOptions
options) (\s :: CreateTransitGateway
s@CreateTransitGateway' {} Maybe TransitGatewayRequestOptions
a -> CreateTransitGateway
s {$sel:options:CreateTransitGateway' :: Maybe TransitGatewayRequestOptions
options = Maybe TransitGatewayRequestOptions
a} :: CreateTransitGateway)

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

instance Core.AWSRequest CreateTransitGateway where
  type
    AWSResponse CreateTransitGateway =
      CreateTransitGatewayResponse
  request :: (Service -> Service)
-> CreateTransitGateway -> Request CreateTransitGateway
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 CreateTransitGateway
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse CreateTransitGateway)))
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 TransitGateway -> Int -> CreateTransitGatewayResponse
CreateTransitGatewayResponse'
            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
"transitGateway")
            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 CreateTransitGateway where
  hashWithSalt :: Int -> CreateTransitGateway -> Int
hashWithSalt Int
_salt CreateTransitGateway' {Maybe Bool
Maybe [TagSpecification]
Maybe Text
Maybe TransitGatewayRequestOptions
tagSpecifications :: Maybe [TagSpecification]
options :: Maybe TransitGatewayRequestOptions
dryRun :: Maybe Bool
description :: Maybe Text
$sel:tagSpecifications:CreateTransitGateway' :: CreateTransitGateway -> Maybe [TagSpecification]
$sel:options:CreateTransitGateway' :: CreateTransitGateway -> Maybe TransitGatewayRequestOptions
$sel:dryRun:CreateTransitGateway' :: CreateTransitGateway -> Maybe Bool
$sel:description:CreateTransitGateway' :: CreateTransitGateway -> Maybe Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
description
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Bool
dryRun
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe TransitGatewayRequestOptions
options
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [TagSpecification]
tagSpecifications

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

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

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

instance Data.ToQuery CreateTransitGateway where
  toQuery :: CreateTransitGateway -> QueryString
toQuery CreateTransitGateway' {Maybe Bool
Maybe [TagSpecification]
Maybe Text
Maybe TransitGatewayRequestOptions
tagSpecifications :: Maybe [TagSpecification]
options :: Maybe TransitGatewayRequestOptions
dryRun :: Maybe Bool
description :: Maybe Text
$sel:tagSpecifications:CreateTransitGateway' :: CreateTransitGateway -> Maybe [TagSpecification]
$sel:options:CreateTransitGateway' :: CreateTransitGateway -> Maybe TransitGatewayRequestOptions
$sel:dryRun:CreateTransitGateway' :: CreateTransitGateway -> Maybe Bool
$sel:description:CreateTransitGateway' :: CreateTransitGateway -> Maybe Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"Action"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: (ByteString
"CreateTransitGateway" :: Prelude.ByteString),
        ByteString
"Version"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: (ByteString
"2016-11-15" :: Prelude.ByteString),
        ByteString
"Description" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Text
description,
        ByteString
"DryRun" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Bool
dryRun,
        ByteString
"Options" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe TransitGatewayRequestOptions
options,
        forall a. ToQuery a => a -> QueryString
Data.toQuery
          ( forall a.
(IsList a, ToQuery (Item a)) =>
ByteString -> a -> QueryString
Data.toQueryList ByteString
"TagSpecification"
              forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe [TagSpecification]
tagSpecifications
          )
      ]

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

-- |
-- Create a value of 'CreateTransitGatewayResponse' 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:
--
-- 'transitGateway', 'createTransitGatewayResponse_transitGateway' - Information about the transit gateway.
--
-- 'httpStatus', 'createTransitGatewayResponse_httpStatus' - The response's http status code.
newCreateTransitGatewayResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  CreateTransitGatewayResponse
newCreateTransitGatewayResponse :: Int -> CreateTransitGatewayResponse
newCreateTransitGatewayResponse Int
pHttpStatus_ =
  CreateTransitGatewayResponse'
    { $sel:transitGateway:CreateTransitGatewayResponse' :: Maybe TransitGateway
transitGateway =
        forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:CreateTransitGatewayResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | Information about the transit gateway.
createTransitGatewayResponse_transitGateway :: Lens.Lens' CreateTransitGatewayResponse (Prelude.Maybe TransitGateway)
createTransitGatewayResponse_transitGateway :: Lens' CreateTransitGatewayResponse (Maybe TransitGateway)
createTransitGatewayResponse_transitGateway = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateTransitGatewayResponse' {Maybe TransitGateway
transitGateway :: Maybe TransitGateway
$sel:transitGateway:CreateTransitGatewayResponse' :: CreateTransitGatewayResponse -> Maybe TransitGateway
transitGateway} -> Maybe TransitGateway
transitGateway) (\s :: CreateTransitGatewayResponse
s@CreateTransitGatewayResponse' {} Maybe TransitGateway
a -> CreateTransitGatewayResponse
s {$sel:transitGateway:CreateTransitGatewayResponse' :: Maybe TransitGateway
transitGateway = Maybe TransitGateway
a} :: CreateTransitGatewayResponse)

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

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