{-# 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.NetworkManager.CreateTransitGatewayRouteTableAttachment
-- 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 route table attachment.
module Amazonka.NetworkManager.CreateTransitGatewayRouteTableAttachment
  ( -- * Creating a Request
    CreateTransitGatewayRouteTableAttachment (..),
    newCreateTransitGatewayRouteTableAttachment,

    -- * Request Lenses
    createTransitGatewayRouteTableAttachment_clientToken,
    createTransitGatewayRouteTableAttachment_tags,
    createTransitGatewayRouteTableAttachment_peeringId,
    createTransitGatewayRouteTableAttachment_transitGatewayRouteTableArn,

    -- * Destructuring the Response
    CreateTransitGatewayRouteTableAttachmentResponse (..),
    newCreateTransitGatewayRouteTableAttachmentResponse,

    -- * Response Lenses
    createTransitGatewayRouteTableAttachmentResponse_transitGatewayRouteTableAttachment,
    createTransitGatewayRouteTableAttachmentResponse_httpStatus,
  )
where

import qualified Amazonka.Core as Core
import qualified Amazonka.Core.Lens.Internal as Lens
import qualified Amazonka.Data as Data
import Amazonka.NetworkManager.Types
import qualified Amazonka.Prelude as Prelude
import qualified Amazonka.Request as Request
import qualified Amazonka.Response as Response

-- | /See:/ 'newCreateTransitGatewayRouteTableAttachment' smart constructor.
data CreateTransitGatewayRouteTableAttachment = CreateTransitGatewayRouteTableAttachment'
  { -- | The client token associated with the request.
    CreateTransitGatewayRouteTableAttachment -> Maybe Text
clientToken :: Prelude.Maybe Prelude.Text,
    -- | The list of key-value tags associated with the request.
    CreateTransitGatewayRouteTableAttachment -> Maybe [Tag]
tags :: Prelude.Maybe [Tag],
    -- | The ID of the peer for the
    CreateTransitGatewayRouteTableAttachment -> Text
peeringId :: Prelude.Text,
    -- | The ARN of the transit gateway route table for the attachment request.
    CreateTransitGatewayRouteTableAttachment -> Text
transitGatewayRouteTableArn :: Prelude.Text
  }
  deriving (CreateTransitGatewayRouteTableAttachment
-> CreateTransitGatewayRouteTableAttachment -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateTransitGatewayRouteTableAttachment
-> CreateTransitGatewayRouteTableAttachment -> Bool
$c/= :: CreateTransitGatewayRouteTableAttachment
-> CreateTransitGatewayRouteTableAttachment -> Bool
== :: CreateTransitGatewayRouteTableAttachment
-> CreateTransitGatewayRouteTableAttachment -> Bool
$c== :: CreateTransitGatewayRouteTableAttachment
-> CreateTransitGatewayRouteTableAttachment -> Bool
Prelude.Eq, ReadPrec [CreateTransitGatewayRouteTableAttachment]
ReadPrec CreateTransitGatewayRouteTableAttachment
Int -> ReadS CreateTransitGatewayRouteTableAttachment
ReadS [CreateTransitGatewayRouteTableAttachment]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CreateTransitGatewayRouteTableAttachment]
$creadListPrec :: ReadPrec [CreateTransitGatewayRouteTableAttachment]
readPrec :: ReadPrec CreateTransitGatewayRouteTableAttachment
$creadPrec :: ReadPrec CreateTransitGatewayRouteTableAttachment
readList :: ReadS [CreateTransitGatewayRouteTableAttachment]
$creadList :: ReadS [CreateTransitGatewayRouteTableAttachment]
readsPrec :: Int -> ReadS CreateTransitGatewayRouteTableAttachment
$creadsPrec :: Int -> ReadS CreateTransitGatewayRouteTableAttachment
Prelude.Read, Int -> CreateTransitGatewayRouteTableAttachment -> ShowS
[CreateTransitGatewayRouteTableAttachment] -> ShowS
CreateTransitGatewayRouteTableAttachment -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateTransitGatewayRouteTableAttachment] -> ShowS
$cshowList :: [CreateTransitGatewayRouteTableAttachment] -> ShowS
show :: CreateTransitGatewayRouteTableAttachment -> String
$cshow :: CreateTransitGatewayRouteTableAttachment -> String
showsPrec :: Int -> CreateTransitGatewayRouteTableAttachment -> ShowS
$cshowsPrec :: Int -> CreateTransitGatewayRouteTableAttachment -> ShowS
Prelude.Show, forall x.
Rep CreateTransitGatewayRouteTableAttachment x
-> CreateTransitGatewayRouteTableAttachment
forall x.
CreateTransitGatewayRouteTableAttachment
-> Rep CreateTransitGatewayRouteTableAttachment x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep CreateTransitGatewayRouteTableAttachment x
-> CreateTransitGatewayRouteTableAttachment
$cfrom :: forall x.
CreateTransitGatewayRouteTableAttachment
-> Rep CreateTransitGatewayRouteTableAttachment x
Prelude.Generic)

-- |
-- Create a value of 'CreateTransitGatewayRouteTableAttachment' 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:
--
-- 'clientToken', 'createTransitGatewayRouteTableAttachment_clientToken' - The client token associated with the request.
--
-- 'tags', 'createTransitGatewayRouteTableAttachment_tags' - The list of key-value tags associated with the request.
--
-- 'peeringId', 'createTransitGatewayRouteTableAttachment_peeringId' - The ID of the peer for the
--
-- 'transitGatewayRouteTableArn', 'createTransitGatewayRouteTableAttachment_transitGatewayRouteTableArn' - The ARN of the transit gateway route table for the attachment request.
newCreateTransitGatewayRouteTableAttachment ::
  -- | 'peeringId'
  Prelude.Text ->
  -- | 'transitGatewayRouteTableArn'
  Prelude.Text ->
  CreateTransitGatewayRouteTableAttachment
newCreateTransitGatewayRouteTableAttachment :: Text -> Text -> CreateTransitGatewayRouteTableAttachment
newCreateTransitGatewayRouteTableAttachment
  Text
pPeeringId_
  Text
pTransitGatewayRouteTableArn_ =
    CreateTransitGatewayRouteTableAttachment'
      { $sel:clientToken:CreateTransitGatewayRouteTableAttachment' :: Maybe Text
clientToken =
          forall a. Maybe a
Prelude.Nothing,
        $sel:tags:CreateTransitGatewayRouteTableAttachment' :: Maybe [Tag]
tags = forall a. Maybe a
Prelude.Nothing,
        $sel:peeringId:CreateTransitGatewayRouteTableAttachment' :: Text
peeringId = Text
pPeeringId_,
        $sel:transitGatewayRouteTableArn:CreateTransitGatewayRouteTableAttachment' :: Text
transitGatewayRouteTableArn =
          Text
pTransitGatewayRouteTableArn_
      }

-- | The client token associated with the request.
createTransitGatewayRouteTableAttachment_clientToken :: Lens.Lens' CreateTransitGatewayRouteTableAttachment (Prelude.Maybe Prelude.Text)
createTransitGatewayRouteTableAttachment_clientToken :: Lens' CreateTransitGatewayRouteTableAttachment (Maybe Text)
createTransitGatewayRouteTableAttachment_clientToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateTransitGatewayRouteTableAttachment' {Maybe Text
clientToken :: Maybe Text
$sel:clientToken:CreateTransitGatewayRouteTableAttachment' :: CreateTransitGatewayRouteTableAttachment -> Maybe Text
clientToken} -> Maybe Text
clientToken) (\s :: CreateTransitGatewayRouteTableAttachment
s@CreateTransitGatewayRouteTableAttachment' {} Maybe Text
a -> CreateTransitGatewayRouteTableAttachment
s {$sel:clientToken:CreateTransitGatewayRouteTableAttachment' :: Maybe Text
clientToken = Maybe Text
a} :: CreateTransitGatewayRouteTableAttachment)

-- | The list of key-value tags associated with the request.
createTransitGatewayRouteTableAttachment_tags :: Lens.Lens' CreateTransitGatewayRouteTableAttachment (Prelude.Maybe [Tag])
createTransitGatewayRouteTableAttachment_tags :: Lens' CreateTransitGatewayRouteTableAttachment (Maybe [Tag])
createTransitGatewayRouteTableAttachment_tags = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateTransitGatewayRouteTableAttachment' {Maybe [Tag]
tags :: Maybe [Tag]
$sel:tags:CreateTransitGatewayRouteTableAttachment' :: CreateTransitGatewayRouteTableAttachment -> Maybe [Tag]
tags} -> Maybe [Tag]
tags) (\s :: CreateTransitGatewayRouteTableAttachment
s@CreateTransitGatewayRouteTableAttachment' {} Maybe [Tag]
a -> CreateTransitGatewayRouteTableAttachment
s {$sel:tags:CreateTransitGatewayRouteTableAttachment' :: Maybe [Tag]
tags = Maybe [Tag]
a} :: CreateTransitGatewayRouteTableAttachment) 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 peer for the
createTransitGatewayRouteTableAttachment_peeringId :: Lens.Lens' CreateTransitGatewayRouteTableAttachment Prelude.Text
createTransitGatewayRouteTableAttachment_peeringId :: Lens' CreateTransitGatewayRouteTableAttachment Text
createTransitGatewayRouteTableAttachment_peeringId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateTransitGatewayRouteTableAttachment' {Text
peeringId :: Text
$sel:peeringId:CreateTransitGatewayRouteTableAttachment' :: CreateTransitGatewayRouteTableAttachment -> Text
peeringId} -> Text
peeringId) (\s :: CreateTransitGatewayRouteTableAttachment
s@CreateTransitGatewayRouteTableAttachment' {} Text
a -> CreateTransitGatewayRouteTableAttachment
s {$sel:peeringId:CreateTransitGatewayRouteTableAttachment' :: Text
peeringId = Text
a} :: CreateTransitGatewayRouteTableAttachment)

-- | The ARN of the transit gateway route table for the attachment request.
createTransitGatewayRouteTableAttachment_transitGatewayRouteTableArn :: Lens.Lens' CreateTransitGatewayRouteTableAttachment Prelude.Text
createTransitGatewayRouteTableAttachment_transitGatewayRouteTableArn :: Lens' CreateTransitGatewayRouteTableAttachment Text
createTransitGatewayRouteTableAttachment_transitGatewayRouteTableArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateTransitGatewayRouteTableAttachment' {Text
transitGatewayRouteTableArn :: Text
$sel:transitGatewayRouteTableArn:CreateTransitGatewayRouteTableAttachment' :: CreateTransitGatewayRouteTableAttachment -> Text
transitGatewayRouteTableArn} -> Text
transitGatewayRouteTableArn) (\s :: CreateTransitGatewayRouteTableAttachment
s@CreateTransitGatewayRouteTableAttachment' {} Text
a -> CreateTransitGatewayRouteTableAttachment
s {$sel:transitGatewayRouteTableArn:CreateTransitGatewayRouteTableAttachment' :: Text
transitGatewayRouteTableArn = Text
a} :: CreateTransitGatewayRouteTableAttachment)

instance
  Core.AWSRequest
    CreateTransitGatewayRouteTableAttachment
  where
  type
    AWSResponse
      CreateTransitGatewayRouteTableAttachment =
      CreateTransitGatewayRouteTableAttachmentResponse
  request :: (Service -> Service)
-> CreateTransitGatewayRouteTableAttachment
-> Request CreateTransitGatewayRouteTableAttachment
request Service -> Service
overrides =
    forall a. (ToRequest a, ToJSON a) => Service -> a -> Request a
Request.postJSON (Service -> Service
overrides Service
defaultService)
  response :: forall (m :: * -> *).
MonadResource m =>
(ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy CreateTransitGatewayRouteTableAttachment
-> ClientResponse ClientBody
-> m (Either
        Error
        (ClientResponse
           (AWSResponse CreateTransitGatewayRouteTableAttachment)))
response =
    forall (m :: * -> *) a.
MonadResource m =>
(Int -> ResponseHeaders -> Object -> Either String (AWSResponse a))
-> (ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy a
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse a)))
Response.receiveJSON
      ( \Int
s ResponseHeaders
h Object
x ->
          Maybe TransitGatewayRouteTableAttachment
-> Int -> CreateTransitGatewayRouteTableAttachmentResponse
CreateTransitGatewayRouteTableAttachmentResponse'
            forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"TransitGatewayRouteTableAttachment")
            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
    CreateTransitGatewayRouteTableAttachment
  where
  hashWithSalt :: Int -> CreateTransitGatewayRouteTableAttachment -> Int
hashWithSalt
    Int
_salt
    CreateTransitGatewayRouteTableAttachment' {Maybe [Tag]
Maybe Text
Text
transitGatewayRouteTableArn :: Text
peeringId :: Text
tags :: Maybe [Tag]
clientToken :: Maybe Text
$sel:transitGatewayRouteTableArn:CreateTransitGatewayRouteTableAttachment' :: CreateTransitGatewayRouteTableAttachment -> Text
$sel:peeringId:CreateTransitGatewayRouteTableAttachment' :: CreateTransitGatewayRouteTableAttachment -> Text
$sel:tags:CreateTransitGatewayRouteTableAttachment' :: CreateTransitGatewayRouteTableAttachment -> Maybe [Tag]
$sel:clientToken:CreateTransitGatewayRouteTableAttachment' :: CreateTransitGatewayRouteTableAttachment -> Maybe Text
..} =
      Int
_salt
        forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
clientToken
        forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [Tag]
tags
        forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
peeringId
        forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
transitGatewayRouteTableArn

instance
  Prelude.NFData
    CreateTransitGatewayRouteTableAttachment
  where
  rnf :: CreateTransitGatewayRouteTableAttachment -> ()
rnf CreateTransitGatewayRouteTableAttachment' {Maybe [Tag]
Maybe Text
Text
transitGatewayRouteTableArn :: Text
peeringId :: Text
tags :: Maybe [Tag]
clientToken :: Maybe Text
$sel:transitGatewayRouteTableArn:CreateTransitGatewayRouteTableAttachment' :: CreateTransitGatewayRouteTableAttachment -> Text
$sel:peeringId:CreateTransitGatewayRouteTableAttachment' :: CreateTransitGatewayRouteTableAttachment -> Text
$sel:tags:CreateTransitGatewayRouteTableAttachment' :: CreateTransitGatewayRouteTableAttachment -> Maybe [Tag]
$sel:clientToken:CreateTransitGatewayRouteTableAttachment' :: CreateTransitGatewayRouteTableAttachment -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
clientToken
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [Tag]
tags
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
peeringId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
transitGatewayRouteTableArn

instance
  Data.ToHeaders
    CreateTransitGatewayRouteTableAttachment
  where
  toHeaders :: CreateTransitGatewayRouteTableAttachment -> ResponseHeaders
toHeaders =
    forall a b. a -> b -> a
Prelude.const
      ( forall a. Monoid a => [a] -> a
Prelude.mconcat
          [ HeaderName
"Content-Type"
              forall a. ToHeader a => HeaderName -> a -> ResponseHeaders
Data.=# ( ByteString
"application/x-amz-json-1.1" ::
                          Prelude.ByteString
                      )
          ]
      )

instance
  Data.ToJSON
    CreateTransitGatewayRouteTableAttachment
  where
  toJSON :: CreateTransitGatewayRouteTableAttachment -> Value
toJSON CreateTransitGatewayRouteTableAttachment' {Maybe [Tag]
Maybe Text
Text
transitGatewayRouteTableArn :: Text
peeringId :: Text
tags :: Maybe [Tag]
clientToken :: Maybe Text
$sel:transitGatewayRouteTableArn:CreateTransitGatewayRouteTableAttachment' :: CreateTransitGatewayRouteTableAttachment -> Text
$sel:peeringId:CreateTransitGatewayRouteTableAttachment' :: CreateTransitGatewayRouteTableAttachment -> Text
$sel:tags:CreateTransitGatewayRouteTableAttachment' :: CreateTransitGatewayRouteTableAttachment -> Maybe [Tag]
$sel:clientToken:CreateTransitGatewayRouteTableAttachment' :: CreateTransitGatewayRouteTableAttachment -> Maybe Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"ClientToken" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe Text
clientToken,
            (Key
"Tags" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe [Tag]
tags,
            forall a. a -> Maybe a
Prelude.Just (Key
"PeeringId" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
peeringId),
            forall a. a -> Maybe a
Prelude.Just
              ( Key
"TransitGatewayRouteTableArn"
                  forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
transitGatewayRouteTableArn
              )
          ]
      )

instance
  Data.ToPath
    CreateTransitGatewayRouteTableAttachment
  where
  toPath :: CreateTransitGatewayRouteTableAttachment -> ByteString
toPath =
    forall a b. a -> b -> a
Prelude.const
      ByteString
"/transit-gateway-route-table-attachments"

instance
  Data.ToQuery
    CreateTransitGatewayRouteTableAttachment
  where
  toQuery :: CreateTransitGatewayRouteTableAttachment -> QueryString
toQuery = forall a b. a -> b -> a
Prelude.const forall a. Monoid a => a
Prelude.mempty

-- | /See:/ 'newCreateTransitGatewayRouteTableAttachmentResponse' smart constructor.
data CreateTransitGatewayRouteTableAttachmentResponse = CreateTransitGatewayRouteTableAttachmentResponse'
  { -- | The route table associated with the create transit gateway route table
    -- attachment request.
    CreateTransitGatewayRouteTableAttachmentResponse
-> Maybe TransitGatewayRouteTableAttachment
transitGatewayRouteTableAttachment :: Prelude.Maybe TransitGatewayRouteTableAttachment,
    -- | The response's http status code.
    CreateTransitGatewayRouteTableAttachmentResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (CreateTransitGatewayRouteTableAttachmentResponse
-> CreateTransitGatewayRouteTableAttachmentResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateTransitGatewayRouteTableAttachmentResponse
-> CreateTransitGatewayRouteTableAttachmentResponse -> Bool
$c/= :: CreateTransitGatewayRouteTableAttachmentResponse
-> CreateTransitGatewayRouteTableAttachmentResponse -> Bool
== :: CreateTransitGatewayRouteTableAttachmentResponse
-> CreateTransitGatewayRouteTableAttachmentResponse -> Bool
$c== :: CreateTransitGatewayRouteTableAttachmentResponse
-> CreateTransitGatewayRouteTableAttachmentResponse -> Bool
Prelude.Eq, ReadPrec [CreateTransitGatewayRouteTableAttachmentResponse]
ReadPrec CreateTransitGatewayRouteTableAttachmentResponse
Int -> ReadS CreateTransitGatewayRouteTableAttachmentResponse
ReadS [CreateTransitGatewayRouteTableAttachmentResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CreateTransitGatewayRouteTableAttachmentResponse]
$creadListPrec :: ReadPrec [CreateTransitGatewayRouteTableAttachmentResponse]
readPrec :: ReadPrec CreateTransitGatewayRouteTableAttachmentResponse
$creadPrec :: ReadPrec CreateTransitGatewayRouteTableAttachmentResponse
readList :: ReadS [CreateTransitGatewayRouteTableAttachmentResponse]
$creadList :: ReadS [CreateTransitGatewayRouteTableAttachmentResponse]
readsPrec :: Int -> ReadS CreateTransitGatewayRouteTableAttachmentResponse
$creadsPrec :: Int -> ReadS CreateTransitGatewayRouteTableAttachmentResponse
Prelude.Read, Int -> CreateTransitGatewayRouteTableAttachmentResponse -> ShowS
[CreateTransitGatewayRouteTableAttachmentResponse] -> ShowS
CreateTransitGatewayRouteTableAttachmentResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateTransitGatewayRouteTableAttachmentResponse] -> ShowS
$cshowList :: [CreateTransitGatewayRouteTableAttachmentResponse] -> ShowS
show :: CreateTransitGatewayRouteTableAttachmentResponse -> String
$cshow :: CreateTransitGatewayRouteTableAttachmentResponse -> String
showsPrec :: Int -> CreateTransitGatewayRouteTableAttachmentResponse -> ShowS
$cshowsPrec :: Int -> CreateTransitGatewayRouteTableAttachmentResponse -> ShowS
Prelude.Show, forall x.
Rep CreateTransitGatewayRouteTableAttachmentResponse x
-> CreateTransitGatewayRouteTableAttachmentResponse
forall x.
CreateTransitGatewayRouteTableAttachmentResponse
-> Rep CreateTransitGatewayRouteTableAttachmentResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep CreateTransitGatewayRouteTableAttachmentResponse x
-> CreateTransitGatewayRouteTableAttachmentResponse
$cfrom :: forall x.
CreateTransitGatewayRouteTableAttachmentResponse
-> Rep CreateTransitGatewayRouteTableAttachmentResponse x
Prelude.Generic)

-- |
-- Create a value of 'CreateTransitGatewayRouteTableAttachmentResponse' 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:
--
-- 'transitGatewayRouteTableAttachment', 'createTransitGatewayRouteTableAttachmentResponse_transitGatewayRouteTableAttachment' - The route table associated with the create transit gateway route table
-- attachment request.
--
-- 'httpStatus', 'createTransitGatewayRouteTableAttachmentResponse_httpStatus' - The response's http status code.
newCreateTransitGatewayRouteTableAttachmentResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  CreateTransitGatewayRouteTableAttachmentResponse
newCreateTransitGatewayRouteTableAttachmentResponse :: Int -> CreateTransitGatewayRouteTableAttachmentResponse
newCreateTransitGatewayRouteTableAttachmentResponse
  Int
pHttpStatus_ =
    CreateTransitGatewayRouteTableAttachmentResponse'
      { $sel:transitGatewayRouteTableAttachment:CreateTransitGatewayRouteTableAttachmentResponse' :: Maybe TransitGatewayRouteTableAttachment
transitGatewayRouteTableAttachment =
          forall a. Maybe a
Prelude.Nothing,
        $sel:httpStatus:CreateTransitGatewayRouteTableAttachmentResponse' :: Int
httpStatus = Int
pHttpStatus_
      }

-- | The route table associated with the create transit gateway route table
-- attachment request.
createTransitGatewayRouteTableAttachmentResponse_transitGatewayRouteTableAttachment :: Lens.Lens' CreateTransitGatewayRouteTableAttachmentResponse (Prelude.Maybe TransitGatewayRouteTableAttachment)
createTransitGatewayRouteTableAttachmentResponse_transitGatewayRouteTableAttachment :: Lens'
  CreateTransitGatewayRouteTableAttachmentResponse
  (Maybe TransitGatewayRouteTableAttachment)
createTransitGatewayRouteTableAttachmentResponse_transitGatewayRouteTableAttachment = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateTransitGatewayRouteTableAttachmentResponse' {Maybe TransitGatewayRouteTableAttachment
transitGatewayRouteTableAttachment :: Maybe TransitGatewayRouteTableAttachment
$sel:transitGatewayRouteTableAttachment:CreateTransitGatewayRouteTableAttachmentResponse' :: CreateTransitGatewayRouteTableAttachmentResponse
-> Maybe TransitGatewayRouteTableAttachment
transitGatewayRouteTableAttachment} -> Maybe TransitGatewayRouteTableAttachment
transitGatewayRouteTableAttachment) (\s :: CreateTransitGatewayRouteTableAttachmentResponse
s@CreateTransitGatewayRouteTableAttachmentResponse' {} Maybe TransitGatewayRouteTableAttachment
a -> CreateTransitGatewayRouteTableAttachmentResponse
s {$sel:transitGatewayRouteTableAttachment:CreateTransitGatewayRouteTableAttachmentResponse' :: Maybe TransitGatewayRouteTableAttachment
transitGatewayRouteTableAttachment = Maybe TransitGatewayRouteTableAttachment
a} :: CreateTransitGatewayRouteTableAttachmentResponse)

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

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