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

    -- * Request Lenses
    rejectTransitGatewayPeeringAttachment_dryRun,
    rejectTransitGatewayPeeringAttachment_transitGatewayAttachmentId,

    -- * Destructuring the Response
    RejectTransitGatewayPeeringAttachmentResponse (..),
    newRejectTransitGatewayPeeringAttachmentResponse,

    -- * Response Lenses
    rejectTransitGatewayPeeringAttachmentResponse_transitGatewayPeeringAttachment,
    rejectTransitGatewayPeeringAttachmentResponse_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:/ 'newRejectTransitGatewayPeeringAttachment' smart constructor.
data RejectTransitGatewayPeeringAttachment = RejectTransitGatewayPeeringAttachment'
  { -- | 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@.
    RejectTransitGatewayPeeringAttachment -> Maybe Bool
dryRun :: Prelude.Maybe Prelude.Bool,
    -- | The ID of the transit gateway peering attachment.
    RejectTransitGatewayPeeringAttachment -> Text
transitGatewayAttachmentId :: Prelude.Text
  }
  deriving (RejectTransitGatewayPeeringAttachment
-> RejectTransitGatewayPeeringAttachment -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RejectTransitGatewayPeeringAttachment
-> RejectTransitGatewayPeeringAttachment -> Bool
$c/= :: RejectTransitGatewayPeeringAttachment
-> RejectTransitGatewayPeeringAttachment -> Bool
== :: RejectTransitGatewayPeeringAttachment
-> RejectTransitGatewayPeeringAttachment -> Bool
$c== :: RejectTransitGatewayPeeringAttachment
-> RejectTransitGatewayPeeringAttachment -> Bool
Prelude.Eq, ReadPrec [RejectTransitGatewayPeeringAttachment]
ReadPrec RejectTransitGatewayPeeringAttachment
Int -> ReadS RejectTransitGatewayPeeringAttachment
ReadS [RejectTransitGatewayPeeringAttachment]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [RejectTransitGatewayPeeringAttachment]
$creadListPrec :: ReadPrec [RejectTransitGatewayPeeringAttachment]
readPrec :: ReadPrec RejectTransitGatewayPeeringAttachment
$creadPrec :: ReadPrec RejectTransitGatewayPeeringAttachment
readList :: ReadS [RejectTransitGatewayPeeringAttachment]
$creadList :: ReadS [RejectTransitGatewayPeeringAttachment]
readsPrec :: Int -> ReadS RejectTransitGatewayPeeringAttachment
$creadsPrec :: Int -> ReadS RejectTransitGatewayPeeringAttachment
Prelude.Read, Int -> RejectTransitGatewayPeeringAttachment -> ShowS
[RejectTransitGatewayPeeringAttachment] -> ShowS
RejectTransitGatewayPeeringAttachment -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RejectTransitGatewayPeeringAttachment] -> ShowS
$cshowList :: [RejectTransitGatewayPeeringAttachment] -> ShowS
show :: RejectTransitGatewayPeeringAttachment -> String
$cshow :: RejectTransitGatewayPeeringAttachment -> String
showsPrec :: Int -> RejectTransitGatewayPeeringAttachment -> ShowS
$cshowsPrec :: Int -> RejectTransitGatewayPeeringAttachment -> ShowS
Prelude.Show, forall x.
Rep RejectTransitGatewayPeeringAttachment x
-> RejectTransitGatewayPeeringAttachment
forall x.
RejectTransitGatewayPeeringAttachment
-> Rep RejectTransitGatewayPeeringAttachment x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep RejectTransitGatewayPeeringAttachment x
-> RejectTransitGatewayPeeringAttachment
$cfrom :: forall x.
RejectTransitGatewayPeeringAttachment
-> Rep RejectTransitGatewayPeeringAttachment x
Prelude.Generic)

-- |
-- Create a value of 'RejectTransitGatewayPeeringAttachment' 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', 'rejectTransitGatewayPeeringAttachment_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@.
--
-- 'transitGatewayAttachmentId', 'rejectTransitGatewayPeeringAttachment_transitGatewayAttachmentId' - The ID of the transit gateway peering attachment.
newRejectTransitGatewayPeeringAttachment ::
  -- | 'transitGatewayAttachmentId'
  Prelude.Text ->
  RejectTransitGatewayPeeringAttachment
newRejectTransitGatewayPeeringAttachment :: Text -> RejectTransitGatewayPeeringAttachment
newRejectTransitGatewayPeeringAttachment
  Text
pTransitGatewayAttachmentId_ =
    RejectTransitGatewayPeeringAttachment'
      { $sel:dryRun:RejectTransitGatewayPeeringAttachment' :: Maybe Bool
dryRun =
          forall a. Maybe a
Prelude.Nothing,
        $sel:transitGatewayAttachmentId:RejectTransitGatewayPeeringAttachment' :: Text
transitGatewayAttachmentId =
          Text
pTransitGatewayAttachmentId_
      }

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

-- | The ID of the transit gateway peering attachment.
rejectTransitGatewayPeeringAttachment_transitGatewayAttachmentId :: Lens.Lens' RejectTransitGatewayPeeringAttachment Prelude.Text
rejectTransitGatewayPeeringAttachment_transitGatewayAttachmentId :: Lens' RejectTransitGatewayPeeringAttachment Text
rejectTransitGatewayPeeringAttachment_transitGatewayAttachmentId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\RejectTransitGatewayPeeringAttachment' {Text
transitGatewayAttachmentId :: Text
$sel:transitGatewayAttachmentId:RejectTransitGatewayPeeringAttachment' :: RejectTransitGatewayPeeringAttachment -> Text
transitGatewayAttachmentId} -> Text
transitGatewayAttachmentId) (\s :: RejectTransitGatewayPeeringAttachment
s@RejectTransitGatewayPeeringAttachment' {} Text
a -> RejectTransitGatewayPeeringAttachment
s {$sel:transitGatewayAttachmentId:RejectTransitGatewayPeeringAttachment' :: Text
transitGatewayAttachmentId = Text
a} :: RejectTransitGatewayPeeringAttachment)

instance
  Core.AWSRequest
    RejectTransitGatewayPeeringAttachment
  where
  type
    AWSResponse
      RejectTransitGatewayPeeringAttachment =
      RejectTransitGatewayPeeringAttachmentResponse
  request :: (Service -> Service)
-> RejectTransitGatewayPeeringAttachment
-> Request RejectTransitGatewayPeeringAttachment
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 RejectTransitGatewayPeeringAttachment
-> ClientResponse ClientBody
-> m (Either
        Error
        (ClientResponse
           (AWSResponse RejectTransitGatewayPeeringAttachment)))
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 -> RejectTransitGatewayPeeringAttachmentResponse
RejectTransitGatewayPeeringAttachmentResponse'
            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
    RejectTransitGatewayPeeringAttachment
  where
  hashWithSalt :: Int -> RejectTransitGatewayPeeringAttachment -> Int
hashWithSalt
    Int
_salt
    RejectTransitGatewayPeeringAttachment' {Maybe Bool
Text
transitGatewayAttachmentId :: Text
dryRun :: Maybe Bool
$sel:transitGatewayAttachmentId:RejectTransitGatewayPeeringAttachment' :: RejectTransitGatewayPeeringAttachment -> Text
$sel:dryRun:RejectTransitGatewayPeeringAttachment' :: RejectTransitGatewayPeeringAttachment -> 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` Text
transitGatewayAttachmentId

instance
  Prelude.NFData
    RejectTransitGatewayPeeringAttachment
  where
  rnf :: RejectTransitGatewayPeeringAttachment -> ()
rnf RejectTransitGatewayPeeringAttachment' {Maybe Bool
Text
transitGatewayAttachmentId :: Text
dryRun :: Maybe Bool
$sel:transitGatewayAttachmentId:RejectTransitGatewayPeeringAttachment' :: RejectTransitGatewayPeeringAttachment -> Text
$sel:dryRun:RejectTransitGatewayPeeringAttachment' :: RejectTransitGatewayPeeringAttachment -> 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 Text
transitGatewayAttachmentId

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

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

instance
  Data.ToQuery
    RejectTransitGatewayPeeringAttachment
  where
  toQuery :: RejectTransitGatewayPeeringAttachment -> QueryString
toQuery RejectTransitGatewayPeeringAttachment' {Maybe Bool
Text
transitGatewayAttachmentId :: Text
dryRun :: Maybe Bool
$sel:transitGatewayAttachmentId:RejectTransitGatewayPeeringAttachment' :: RejectTransitGatewayPeeringAttachment -> Text
$sel:dryRun:RejectTransitGatewayPeeringAttachment' :: RejectTransitGatewayPeeringAttachment -> Maybe Bool
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"Action"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: ( ByteString
"RejectTransitGatewayPeeringAttachment" ::
                      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
"TransitGatewayAttachmentId"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Text
transitGatewayAttachmentId
      ]

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

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

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

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

instance
  Prelude.NFData
    RejectTransitGatewayPeeringAttachmentResponse
  where
  rnf :: RejectTransitGatewayPeeringAttachmentResponse -> ()
rnf
    RejectTransitGatewayPeeringAttachmentResponse' {Int
Maybe TransitGatewayPeeringAttachment
httpStatus :: Int
transitGatewayPeeringAttachment :: Maybe TransitGatewayPeeringAttachment
$sel:httpStatus:RejectTransitGatewayPeeringAttachmentResponse' :: RejectTransitGatewayPeeringAttachmentResponse -> Int
$sel:transitGatewayPeeringAttachment:RejectTransitGatewayPeeringAttachmentResponse' :: RejectTransitGatewayPeeringAttachmentResponse
-> 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