{-# 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.CreateTransitGatewayPeeringAttachment
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Requests a transit gateway peering attachment between the specified
-- transit gateway (requester) and a peer transit gateway (accepter). The
-- peer transit gateway can be in your account or a different Amazon Web
-- Services account.
--
-- After you create the peering attachment, the owner of the accepter
-- transit gateway must accept the attachment request.
module Amazonka.EC2.CreateTransitGatewayPeeringAttachment
  ( -- * Creating a Request
    CreateTransitGatewayPeeringAttachment (..),
    newCreateTransitGatewayPeeringAttachment,

    -- * Request Lenses
    createTransitGatewayPeeringAttachment_dryRun,
    createTransitGatewayPeeringAttachment_options,
    createTransitGatewayPeeringAttachment_tagSpecifications,
    createTransitGatewayPeeringAttachment_transitGatewayId,
    createTransitGatewayPeeringAttachment_peerTransitGatewayId,
    createTransitGatewayPeeringAttachment_peerAccountId,
    createTransitGatewayPeeringAttachment_peerRegion,

    -- * Destructuring the Response
    CreateTransitGatewayPeeringAttachmentResponse (..),
    newCreateTransitGatewayPeeringAttachmentResponse,

    -- * Response Lenses
    createTransitGatewayPeeringAttachmentResponse_transitGatewayPeeringAttachment,
    createTransitGatewayPeeringAttachmentResponse_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:/ 'newCreateTransitGatewayPeeringAttachment' smart constructor.
data CreateTransitGatewayPeeringAttachment = CreateTransitGatewayPeeringAttachment'
  { -- | 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@.
    CreateTransitGatewayPeeringAttachment -> Maybe Bool
dryRun :: Prelude.Maybe Prelude.Bool,
    -- | Requests a transit gateway peering attachment.
    CreateTransitGatewayPeeringAttachment
-> Maybe CreateTransitGatewayPeeringAttachmentRequestOptions
options :: Prelude.Maybe CreateTransitGatewayPeeringAttachmentRequestOptions,
    -- | The tags to apply to the transit gateway peering attachment.
    CreateTransitGatewayPeeringAttachment -> Maybe [TagSpecification]
tagSpecifications :: Prelude.Maybe [TagSpecification],
    -- | The ID of the transit gateway.
    CreateTransitGatewayPeeringAttachment -> Text
transitGatewayId :: Prelude.Text,
    -- | The ID of the peer transit gateway with which to create the peering
    -- attachment.
    CreateTransitGatewayPeeringAttachment -> Text
peerTransitGatewayId :: Prelude.Text,
    -- | The ID of the Amazon Web Services account that owns the peer transit
    -- gateway.
    CreateTransitGatewayPeeringAttachment -> Text
peerAccountId :: Prelude.Text,
    -- | The Region where the peer transit gateway is located.
    CreateTransitGatewayPeeringAttachment -> Text
peerRegion :: Prelude.Text
  }
  deriving (CreateTransitGatewayPeeringAttachment
-> CreateTransitGatewayPeeringAttachment -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateTransitGatewayPeeringAttachment
-> CreateTransitGatewayPeeringAttachment -> Bool
$c/= :: CreateTransitGatewayPeeringAttachment
-> CreateTransitGatewayPeeringAttachment -> Bool
== :: CreateTransitGatewayPeeringAttachment
-> CreateTransitGatewayPeeringAttachment -> Bool
$c== :: CreateTransitGatewayPeeringAttachment
-> CreateTransitGatewayPeeringAttachment -> Bool
Prelude.Eq, ReadPrec [CreateTransitGatewayPeeringAttachment]
ReadPrec CreateTransitGatewayPeeringAttachment
Int -> ReadS CreateTransitGatewayPeeringAttachment
ReadS [CreateTransitGatewayPeeringAttachment]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CreateTransitGatewayPeeringAttachment]
$creadListPrec :: ReadPrec [CreateTransitGatewayPeeringAttachment]
readPrec :: ReadPrec CreateTransitGatewayPeeringAttachment
$creadPrec :: ReadPrec CreateTransitGatewayPeeringAttachment
readList :: ReadS [CreateTransitGatewayPeeringAttachment]
$creadList :: ReadS [CreateTransitGatewayPeeringAttachment]
readsPrec :: Int -> ReadS CreateTransitGatewayPeeringAttachment
$creadsPrec :: Int -> ReadS CreateTransitGatewayPeeringAttachment
Prelude.Read, Int -> CreateTransitGatewayPeeringAttachment -> ShowS
[CreateTransitGatewayPeeringAttachment] -> ShowS
CreateTransitGatewayPeeringAttachment -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateTransitGatewayPeeringAttachment] -> ShowS
$cshowList :: [CreateTransitGatewayPeeringAttachment] -> ShowS
show :: CreateTransitGatewayPeeringAttachment -> String
$cshow :: CreateTransitGatewayPeeringAttachment -> String
showsPrec :: Int -> CreateTransitGatewayPeeringAttachment -> ShowS
$cshowsPrec :: Int -> CreateTransitGatewayPeeringAttachment -> ShowS
Prelude.Show, forall x.
Rep CreateTransitGatewayPeeringAttachment x
-> CreateTransitGatewayPeeringAttachment
forall x.
CreateTransitGatewayPeeringAttachment
-> Rep CreateTransitGatewayPeeringAttachment x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep CreateTransitGatewayPeeringAttachment x
-> CreateTransitGatewayPeeringAttachment
$cfrom :: forall x.
CreateTransitGatewayPeeringAttachment
-> Rep CreateTransitGatewayPeeringAttachment x
Prelude.Generic)

-- |
-- Create a value of 'CreateTransitGatewayPeeringAttachment' 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', 'createTransitGatewayPeeringAttachment_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', 'createTransitGatewayPeeringAttachment_options' - Requests a transit gateway peering attachment.
--
-- 'tagSpecifications', 'createTransitGatewayPeeringAttachment_tagSpecifications' - The tags to apply to the transit gateway peering attachment.
--
-- 'transitGatewayId', 'createTransitGatewayPeeringAttachment_transitGatewayId' - The ID of the transit gateway.
--
-- 'peerTransitGatewayId', 'createTransitGatewayPeeringAttachment_peerTransitGatewayId' - The ID of the peer transit gateway with which to create the peering
-- attachment.
--
-- 'peerAccountId', 'createTransitGatewayPeeringAttachment_peerAccountId' - The ID of the Amazon Web Services account that owns the peer transit
-- gateway.
--
-- 'peerRegion', 'createTransitGatewayPeeringAttachment_peerRegion' - The Region where the peer transit gateway is located.
newCreateTransitGatewayPeeringAttachment ::
  -- | 'transitGatewayId'
  Prelude.Text ->
  -- | 'peerTransitGatewayId'
  Prelude.Text ->
  -- | 'peerAccountId'
  Prelude.Text ->
  -- | 'peerRegion'
  Prelude.Text ->
  CreateTransitGatewayPeeringAttachment
newCreateTransitGatewayPeeringAttachment :: Text
-> Text -> Text -> Text -> CreateTransitGatewayPeeringAttachment
newCreateTransitGatewayPeeringAttachment
  Text
pTransitGatewayId_
  Text
pPeerTransitGatewayId_
  Text
pPeerAccountId_
  Text
pPeerRegion_ =
    CreateTransitGatewayPeeringAttachment'
      { $sel:dryRun:CreateTransitGatewayPeeringAttachment' :: Maybe Bool
dryRun =
          forall a. Maybe a
Prelude.Nothing,
        $sel:options:CreateTransitGatewayPeeringAttachment' :: Maybe CreateTransitGatewayPeeringAttachmentRequestOptions
options = forall a. Maybe a
Prelude.Nothing,
        $sel:tagSpecifications:CreateTransitGatewayPeeringAttachment' :: Maybe [TagSpecification]
tagSpecifications = forall a. Maybe a
Prelude.Nothing,
        $sel:transitGatewayId:CreateTransitGatewayPeeringAttachment' :: Text
transitGatewayId =
          Text
pTransitGatewayId_,
        $sel:peerTransitGatewayId:CreateTransitGatewayPeeringAttachment' :: Text
peerTransitGatewayId =
          Text
pPeerTransitGatewayId_,
        $sel:peerAccountId:CreateTransitGatewayPeeringAttachment' :: Text
peerAccountId = Text
pPeerAccountId_,
        $sel:peerRegion:CreateTransitGatewayPeeringAttachment' :: Text
peerRegion = Text
pPeerRegion_
      }

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

-- | Requests a transit gateway peering attachment.
createTransitGatewayPeeringAttachment_options :: Lens.Lens' CreateTransitGatewayPeeringAttachment (Prelude.Maybe CreateTransitGatewayPeeringAttachmentRequestOptions)
createTransitGatewayPeeringAttachment_options :: Lens'
  CreateTransitGatewayPeeringAttachment
  (Maybe CreateTransitGatewayPeeringAttachmentRequestOptions)
createTransitGatewayPeeringAttachment_options = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateTransitGatewayPeeringAttachment' {Maybe CreateTransitGatewayPeeringAttachmentRequestOptions
options :: Maybe CreateTransitGatewayPeeringAttachmentRequestOptions
$sel:options:CreateTransitGatewayPeeringAttachment' :: CreateTransitGatewayPeeringAttachment
-> Maybe CreateTransitGatewayPeeringAttachmentRequestOptions
options} -> Maybe CreateTransitGatewayPeeringAttachmentRequestOptions
options) (\s :: CreateTransitGatewayPeeringAttachment
s@CreateTransitGatewayPeeringAttachment' {} Maybe CreateTransitGatewayPeeringAttachmentRequestOptions
a -> CreateTransitGatewayPeeringAttachment
s {$sel:options:CreateTransitGatewayPeeringAttachment' :: Maybe CreateTransitGatewayPeeringAttachmentRequestOptions
options = Maybe CreateTransitGatewayPeeringAttachmentRequestOptions
a} :: CreateTransitGatewayPeeringAttachment)

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

-- | The ID of the peer transit gateway with which to create the peering
-- attachment.
createTransitGatewayPeeringAttachment_peerTransitGatewayId :: Lens.Lens' CreateTransitGatewayPeeringAttachment Prelude.Text
createTransitGatewayPeeringAttachment_peerTransitGatewayId :: Lens' CreateTransitGatewayPeeringAttachment Text
createTransitGatewayPeeringAttachment_peerTransitGatewayId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateTransitGatewayPeeringAttachment' {Text
peerTransitGatewayId :: Text
$sel:peerTransitGatewayId:CreateTransitGatewayPeeringAttachment' :: CreateTransitGatewayPeeringAttachment -> Text
peerTransitGatewayId} -> Text
peerTransitGatewayId) (\s :: CreateTransitGatewayPeeringAttachment
s@CreateTransitGatewayPeeringAttachment' {} Text
a -> CreateTransitGatewayPeeringAttachment
s {$sel:peerTransitGatewayId:CreateTransitGatewayPeeringAttachment' :: Text
peerTransitGatewayId = Text
a} :: CreateTransitGatewayPeeringAttachment)

-- | The ID of the Amazon Web Services account that owns the peer transit
-- gateway.
createTransitGatewayPeeringAttachment_peerAccountId :: Lens.Lens' CreateTransitGatewayPeeringAttachment Prelude.Text
createTransitGatewayPeeringAttachment_peerAccountId :: Lens' CreateTransitGatewayPeeringAttachment Text
createTransitGatewayPeeringAttachment_peerAccountId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateTransitGatewayPeeringAttachment' {Text
peerAccountId :: Text
$sel:peerAccountId:CreateTransitGatewayPeeringAttachment' :: CreateTransitGatewayPeeringAttachment -> Text
peerAccountId} -> Text
peerAccountId) (\s :: CreateTransitGatewayPeeringAttachment
s@CreateTransitGatewayPeeringAttachment' {} Text
a -> CreateTransitGatewayPeeringAttachment
s {$sel:peerAccountId:CreateTransitGatewayPeeringAttachment' :: Text
peerAccountId = Text
a} :: CreateTransitGatewayPeeringAttachment)

-- | The Region where the peer transit gateway is located.
createTransitGatewayPeeringAttachment_peerRegion :: Lens.Lens' CreateTransitGatewayPeeringAttachment Prelude.Text
createTransitGatewayPeeringAttachment_peerRegion :: Lens' CreateTransitGatewayPeeringAttachment Text
createTransitGatewayPeeringAttachment_peerRegion = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateTransitGatewayPeeringAttachment' {Text
peerRegion :: Text
$sel:peerRegion:CreateTransitGatewayPeeringAttachment' :: CreateTransitGatewayPeeringAttachment -> Text
peerRegion} -> Text
peerRegion) (\s :: CreateTransitGatewayPeeringAttachment
s@CreateTransitGatewayPeeringAttachment' {} Text
a -> CreateTransitGatewayPeeringAttachment
s {$sel:peerRegion:CreateTransitGatewayPeeringAttachment' :: Text
peerRegion = Text
a} :: CreateTransitGatewayPeeringAttachment)

instance
  Core.AWSRequest
    CreateTransitGatewayPeeringAttachment
  where
  type
    AWSResponse
      CreateTransitGatewayPeeringAttachment =
      CreateTransitGatewayPeeringAttachmentResponse
  request :: (Service -> Service)
-> CreateTransitGatewayPeeringAttachment
-> Request CreateTransitGatewayPeeringAttachment
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 CreateTransitGatewayPeeringAttachment
-> ClientResponse ClientBody
-> m (Either
        Error
        (ClientResponse
           (AWSResponse CreateTransitGatewayPeeringAttachment)))
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 TransitGatewayPeeringAttachment
-> Int -> CreateTransitGatewayPeeringAttachmentResponse
CreateTransitGatewayPeeringAttachmentResponse'
            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
"transitGatewayPeeringAttachment")
            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
    CreateTransitGatewayPeeringAttachment
  where
  hashWithSalt :: Int -> CreateTransitGatewayPeeringAttachment -> Int
hashWithSalt
    Int
_salt
    CreateTransitGatewayPeeringAttachment' {Maybe Bool
Maybe [TagSpecification]
Maybe CreateTransitGatewayPeeringAttachmentRequestOptions
Text
peerRegion :: Text
peerAccountId :: Text
peerTransitGatewayId :: Text
transitGatewayId :: Text
tagSpecifications :: Maybe [TagSpecification]
options :: Maybe CreateTransitGatewayPeeringAttachmentRequestOptions
dryRun :: Maybe Bool
$sel:peerRegion:CreateTransitGatewayPeeringAttachment' :: CreateTransitGatewayPeeringAttachment -> Text
$sel:peerAccountId:CreateTransitGatewayPeeringAttachment' :: CreateTransitGatewayPeeringAttachment -> Text
$sel:peerTransitGatewayId:CreateTransitGatewayPeeringAttachment' :: CreateTransitGatewayPeeringAttachment -> Text
$sel:transitGatewayId:CreateTransitGatewayPeeringAttachment' :: CreateTransitGatewayPeeringAttachment -> Text
$sel:tagSpecifications:CreateTransitGatewayPeeringAttachment' :: CreateTransitGatewayPeeringAttachment -> Maybe [TagSpecification]
$sel:options:CreateTransitGatewayPeeringAttachment' :: CreateTransitGatewayPeeringAttachment
-> Maybe CreateTransitGatewayPeeringAttachmentRequestOptions
$sel:dryRun:CreateTransitGatewayPeeringAttachment' :: CreateTransitGatewayPeeringAttachment -> 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 CreateTransitGatewayPeeringAttachmentRequestOptions
options
        forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [TagSpecification]
tagSpecifications
        forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
transitGatewayId
        forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
peerTransitGatewayId
        forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
peerAccountId
        forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
peerRegion

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

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

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

instance
  Data.ToQuery
    CreateTransitGatewayPeeringAttachment
  where
  toQuery :: CreateTransitGatewayPeeringAttachment -> QueryString
toQuery CreateTransitGatewayPeeringAttachment' {Maybe Bool
Maybe [TagSpecification]
Maybe CreateTransitGatewayPeeringAttachmentRequestOptions
Text
peerRegion :: Text
peerAccountId :: Text
peerTransitGatewayId :: Text
transitGatewayId :: Text
tagSpecifications :: Maybe [TagSpecification]
options :: Maybe CreateTransitGatewayPeeringAttachmentRequestOptions
dryRun :: Maybe Bool
$sel:peerRegion:CreateTransitGatewayPeeringAttachment' :: CreateTransitGatewayPeeringAttachment -> Text
$sel:peerAccountId:CreateTransitGatewayPeeringAttachment' :: CreateTransitGatewayPeeringAttachment -> Text
$sel:peerTransitGatewayId:CreateTransitGatewayPeeringAttachment' :: CreateTransitGatewayPeeringAttachment -> Text
$sel:transitGatewayId:CreateTransitGatewayPeeringAttachment' :: CreateTransitGatewayPeeringAttachment -> Text
$sel:tagSpecifications:CreateTransitGatewayPeeringAttachment' :: CreateTransitGatewayPeeringAttachment -> Maybe [TagSpecification]
$sel:options:CreateTransitGatewayPeeringAttachment' :: CreateTransitGatewayPeeringAttachment
-> Maybe CreateTransitGatewayPeeringAttachmentRequestOptions
$sel:dryRun:CreateTransitGatewayPeeringAttachment' :: CreateTransitGatewayPeeringAttachment -> Maybe Bool
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"Action"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: ( ByteString
"CreateTransitGatewayPeeringAttachment" ::
                      Prelude.ByteString
                  ),
        ByteString
"Version"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: (ByteString
"2016-11-15" :: Prelude.ByteString),
        ByteString
"DryRun" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Bool
dryRun,
        ByteString
"Options" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe CreateTransitGatewayPeeringAttachmentRequestOptions
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
          ),
        ByteString
"TransitGatewayId" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Text
transitGatewayId,
        ByteString
"PeerTransitGatewayId" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Text
peerTransitGatewayId,
        ByteString
"PeerAccountId" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Text
peerAccountId,
        ByteString
"PeerRegion" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Text
peerRegion
      ]

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

-- |
-- Create a value of 'CreateTransitGatewayPeeringAttachmentResponse' 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:
--
-- 'transitGatewayPeeringAttachment', 'createTransitGatewayPeeringAttachmentResponse_transitGatewayPeeringAttachment' - The transit gateway peering attachment.
--
-- 'httpStatus', 'createTransitGatewayPeeringAttachmentResponse_httpStatus' - The response's http status code.
newCreateTransitGatewayPeeringAttachmentResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  CreateTransitGatewayPeeringAttachmentResponse
newCreateTransitGatewayPeeringAttachmentResponse :: Int -> CreateTransitGatewayPeeringAttachmentResponse
newCreateTransitGatewayPeeringAttachmentResponse
  Int
pHttpStatus_ =
    CreateTransitGatewayPeeringAttachmentResponse'
      { $sel:transitGatewayPeeringAttachment:CreateTransitGatewayPeeringAttachmentResponse' :: Maybe TransitGatewayPeeringAttachment
transitGatewayPeeringAttachment =
          forall a. Maybe a
Prelude.Nothing,
        $sel:httpStatus:CreateTransitGatewayPeeringAttachmentResponse' :: Int
httpStatus = Int
pHttpStatus_
      }

-- | The transit gateway peering attachment.
createTransitGatewayPeeringAttachmentResponse_transitGatewayPeeringAttachment :: Lens.Lens' CreateTransitGatewayPeeringAttachmentResponse (Prelude.Maybe TransitGatewayPeeringAttachment)
createTransitGatewayPeeringAttachmentResponse_transitGatewayPeeringAttachment :: Lens'
  CreateTransitGatewayPeeringAttachmentResponse
  (Maybe TransitGatewayPeeringAttachment)
createTransitGatewayPeeringAttachmentResponse_transitGatewayPeeringAttachment = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateTransitGatewayPeeringAttachmentResponse' {Maybe TransitGatewayPeeringAttachment
transitGatewayPeeringAttachment :: Maybe TransitGatewayPeeringAttachment
$sel:transitGatewayPeeringAttachment:CreateTransitGatewayPeeringAttachmentResponse' :: CreateTransitGatewayPeeringAttachmentResponse
-> Maybe TransitGatewayPeeringAttachment
transitGatewayPeeringAttachment} -> Maybe TransitGatewayPeeringAttachment
transitGatewayPeeringAttachment) (\s :: CreateTransitGatewayPeeringAttachmentResponse
s@CreateTransitGatewayPeeringAttachmentResponse' {} Maybe TransitGatewayPeeringAttachment
a -> CreateTransitGatewayPeeringAttachmentResponse
s {$sel:transitGatewayPeeringAttachment:CreateTransitGatewayPeeringAttachmentResponse' :: Maybe TransitGatewayPeeringAttachment
transitGatewayPeeringAttachment = Maybe TransitGatewayPeeringAttachment
a} :: CreateTransitGatewayPeeringAttachmentResponse)

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

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