{-# 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.UpdateVpcAttachment
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Updates a VPC attachment.
module Amazonka.NetworkManager.UpdateVpcAttachment
  ( -- * Creating a Request
    UpdateVpcAttachment (..),
    newUpdateVpcAttachment,

    -- * Request Lenses
    updateVpcAttachment_addSubnetArns,
    updateVpcAttachment_options,
    updateVpcAttachment_removeSubnetArns,
    updateVpcAttachment_attachmentId,

    -- * Destructuring the Response
    UpdateVpcAttachmentResponse (..),
    newUpdateVpcAttachmentResponse,

    -- * Response Lenses
    updateVpcAttachmentResponse_vpcAttachment,
    updateVpcAttachmentResponse_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:/ 'newUpdateVpcAttachment' smart constructor.
data UpdateVpcAttachment = UpdateVpcAttachment'
  { -- | Adds a subnet ARN to the VPC attachment.
    UpdateVpcAttachment -> Maybe [Text]
addSubnetArns :: Prelude.Maybe [Prelude.Text],
    -- | Additional options for updating the VPC attachment.
    UpdateVpcAttachment -> Maybe VpcOptions
options :: Prelude.Maybe VpcOptions,
    -- | Removes a subnet ARN from the attachment.
    UpdateVpcAttachment -> Maybe [Text]
removeSubnetArns :: Prelude.Maybe [Prelude.Text],
    -- | The ID of the attachment.
    UpdateVpcAttachment -> Text
attachmentId :: Prelude.Text
  }
  deriving (UpdateVpcAttachment -> UpdateVpcAttachment -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UpdateVpcAttachment -> UpdateVpcAttachment -> Bool
$c/= :: UpdateVpcAttachment -> UpdateVpcAttachment -> Bool
== :: UpdateVpcAttachment -> UpdateVpcAttachment -> Bool
$c== :: UpdateVpcAttachment -> UpdateVpcAttachment -> Bool
Prelude.Eq, ReadPrec [UpdateVpcAttachment]
ReadPrec UpdateVpcAttachment
Int -> ReadS UpdateVpcAttachment
ReadS [UpdateVpcAttachment]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [UpdateVpcAttachment]
$creadListPrec :: ReadPrec [UpdateVpcAttachment]
readPrec :: ReadPrec UpdateVpcAttachment
$creadPrec :: ReadPrec UpdateVpcAttachment
readList :: ReadS [UpdateVpcAttachment]
$creadList :: ReadS [UpdateVpcAttachment]
readsPrec :: Int -> ReadS UpdateVpcAttachment
$creadsPrec :: Int -> ReadS UpdateVpcAttachment
Prelude.Read, Int -> UpdateVpcAttachment -> ShowS
[UpdateVpcAttachment] -> ShowS
UpdateVpcAttachment -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UpdateVpcAttachment] -> ShowS
$cshowList :: [UpdateVpcAttachment] -> ShowS
show :: UpdateVpcAttachment -> String
$cshow :: UpdateVpcAttachment -> String
showsPrec :: Int -> UpdateVpcAttachment -> ShowS
$cshowsPrec :: Int -> UpdateVpcAttachment -> ShowS
Prelude.Show, forall x. Rep UpdateVpcAttachment x -> UpdateVpcAttachment
forall x. UpdateVpcAttachment -> Rep UpdateVpcAttachment x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep UpdateVpcAttachment x -> UpdateVpcAttachment
$cfrom :: forall x. UpdateVpcAttachment -> Rep UpdateVpcAttachment x
Prelude.Generic)

-- |
-- Create a value of 'UpdateVpcAttachment' 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:
--
-- 'addSubnetArns', 'updateVpcAttachment_addSubnetArns' - Adds a subnet ARN to the VPC attachment.
--
-- 'options', 'updateVpcAttachment_options' - Additional options for updating the VPC attachment.
--
-- 'removeSubnetArns', 'updateVpcAttachment_removeSubnetArns' - Removes a subnet ARN from the attachment.
--
-- 'attachmentId', 'updateVpcAttachment_attachmentId' - The ID of the attachment.
newUpdateVpcAttachment ::
  -- | 'attachmentId'
  Prelude.Text ->
  UpdateVpcAttachment
newUpdateVpcAttachment :: Text -> UpdateVpcAttachment
newUpdateVpcAttachment Text
pAttachmentId_ =
  UpdateVpcAttachment'
    { $sel:addSubnetArns:UpdateVpcAttachment' :: Maybe [Text]
addSubnetArns =
        forall a. Maybe a
Prelude.Nothing,
      $sel:options:UpdateVpcAttachment' :: Maybe VpcOptions
options = forall a. Maybe a
Prelude.Nothing,
      $sel:removeSubnetArns:UpdateVpcAttachment' :: Maybe [Text]
removeSubnetArns = forall a. Maybe a
Prelude.Nothing,
      $sel:attachmentId:UpdateVpcAttachment' :: Text
attachmentId = Text
pAttachmentId_
    }

-- | Adds a subnet ARN to the VPC attachment.
updateVpcAttachment_addSubnetArns :: Lens.Lens' UpdateVpcAttachment (Prelude.Maybe [Prelude.Text])
updateVpcAttachment_addSubnetArns :: Lens' UpdateVpcAttachment (Maybe [Text])
updateVpcAttachment_addSubnetArns = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateVpcAttachment' {Maybe [Text]
addSubnetArns :: Maybe [Text]
$sel:addSubnetArns:UpdateVpcAttachment' :: UpdateVpcAttachment -> Maybe [Text]
addSubnetArns} -> Maybe [Text]
addSubnetArns) (\s :: UpdateVpcAttachment
s@UpdateVpcAttachment' {} Maybe [Text]
a -> UpdateVpcAttachment
s {$sel:addSubnetArns:UpdateVpcAttachment' :: Maybe [Text]
addSubnetArns = Maybe [Text]
a} :: UpdateVpcAttachment) 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

-- | Additional options for updating the VPC attachment.
updateVpcAttachment_options :: Lens.Lens' UpdateVpcAttachment (Prelude.Maybe VpcOptions)
updateVpcAttachment_options :: Lens' UpdateVpcAttachment (Maybe VpcOptions)
updateVpcAttachment_options = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateVpcAttachment' {Maybe VpcOptions
options :: Maybe VpcOptions
$sel:options:UpdateVpcAttachment' :: UpdateVpcAttachment -> Maybe VpcOptions
options} -> Maybe VpcOptions
options) (\s :: UpdateVpcAttachment
s@UpdateVpcAttachment' {} Maybe VpcOptions
a -> UpdateVpcAttachment
s {$sel:options:UpdateVpcAttachment' :: Maybe VpcOptions
options = Maybe VpcOptions
a} :: UpdateVpcAttachment)

-- | Removes a subnet ARN from the attachment.
updateVpcAttachment_removeSubnetArns :: Lens.Lens' UpdateVpcAttachment (Prelude.Maybe [Prelude.Text])
updateVpcAttachment_removeSubnetArns :: Lens' UpdateVpcAttachment (Maybe [Text])
updateVpcAttachment_removeSubnetArns = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateVpcAttachment' {Maybe [Text]
removeSubnetArns :: Maybe [Text]
$sel:removeSubnetArns:UpdateVpcAttachment' :: UpdateVpcAttachment -> Maybe [Text]
removeSubnetArns} -> Maybe [Text]
removeSubnetArns) (\s :: UpdateVpcAttachment
s@UpdateVpcAttachment' {} Maybe [Text]
a -> UpdateVpcAttachment
s {$sel:removeSubnetArns:UpdateVpcAttachment' :: Maybe [Text]
removeSubnetArns = Maybe [Text]
a} :: UpdateVpcAttachment) 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 attachment.
updateVpcAttachment_attachmentId :: Lens.Lens' UpdateVpcAttachment Prelude.Text
updateVpcAttachment_attachmentId :: Lens' UpdateVpcAttachment Text
updateVpcAttachment_attachmentId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateVpcAttachment' {Text
attachmentId :: Text
$sel:attachmentId:UpdateVpcAttachment' :: UpdateVpcAttachment -> Text
attachmentId} -> Text
attachmentId) (\s :: UpdateVpcAttachment
s@UpdateVpcAttachment' {} Text
a -> UpdateVpcAttachment
s {$sel:attachmentId:UpdateVpcAttachment' :: Text
attachmentId = Text
a} :: UpdateVpcAttachment)

instance Core.AWSRequest UpdateVpcAttachment where
  type
    AWSResponse UpdateVpcAttachment =
      UpdateVpcAttachmentResponse
  request :: (Service -> Service)
-> UpdateVpcAttachment -> Request UpdateVpcAttachment
request Service -> Service
overrides =
    forall a. (ToRequest a, ToJSON a) => Service -> a -> Request a
Request.patchJSON (Service -> Service
overrides Service
defaultService)
  response :: forall (m :: * -> *).
MonadResource m =>
(ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy UpdateVpcAttachment
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse UpdateVpcAttachment)))
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 VpcAttachment -> Int -> UpdateVpcAttachmentResponse
UpdateVpcAttachmentResponse'
            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
"VpcAttachment")
            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 UpdateVpcAttachment where
  hashWithSalt :: Int -> UpdateVpcAttachment -> Int
hashWithSalt Int
_salt UpdateVpcAttachment' {Maybe [Text]
Maybe VpcOptions
Text
attachmentId :: Text
removeSubnetArns :: Maybe [Text]
options :: Maybe VpcOptions
addSubnetArns :: Maybe [Text]
$sel:attachmentId:UpdateVpcAttachment' :: UpdateVpcAttachment -> Text
$sel:removeSubnetArns:UpdateVpcAttachment' :: UpdateVpcAttachment -> Maybe [Text]
$sel:options:UpdateVpcAttachment' :: UpdateVpcAttachment -> Maybe VpcOptions
$sel:addSubnetArns:UpdateVpcAttachment' :: UpdateVpcAttachment -> Maybe [Text]
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [Text]
addSubnetArns
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe VpcOptions
options
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [Text]
removeSubnetArns
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
attachmentId

instance Prelude.NFData UpdateVpcAttachment where
  rnf :: UpdateVpcAttachment -> ()
rnf UpdateVpcAttachment' {Maybe [Text]
Maybe VpcOptions
Text
attachmentId :: Text
removeSubnetArns :: Maybe [Text]
options :: Maybe VpcOptions
addSubnetArns :: Maybe [Text]
$sel:attachmentId:UpdateVpcAttachment' :: UpdateVpcAttachment -> Text
$sel:removeSubnetArns:UpdateVpcAttachment' :: UpdateVpcAttachment -> Maybe [Text]
$sel:options:UpdateVpcAttachment' :: UpdateVpcAttachment -> Maybe VpcOptions
$sel:addSubnetArns:UpdateVpcAttachment' :: UpdateVpcAttachment -> Maybe [Text]
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe [Text]
addSubnetArns
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe VpcOptions
options
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [Text]
removeSubnetArns
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
attachmentId

instance Data.ToHeaders UpdateVpcAttachment where
  toHeaders :: UpdateVpcAttachment -> 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 UpdateVpcAttachment where
  toJSON :: UpdateVpcAttachment -> Value
toJSON UpdateVpcAttachment' {Maybe [Text]
Maybe VpcOptions
Text
attachmentId :: Text
removeSubnetArns :: Maybe [Text]
options :: Maybe VpcOptions
addSubnetArns :: Maybe [Text]
$sel:attachmentId:UpdateVpcAttachment' :: UpdateVpcAttachment -> Text
$sel:removeSubnetArns:UpdateVpcAttachment' :: UpdateVpcAttachment -> Maybe [Text]
$sel:options:UpdateVpcAttachment' :: UpdateVpcAttachment -> Maybe VpcOptions
$sel:addSubnetArns:UpdateVpcAttachment' :: UpdateVpcAttachment -> Maybe [Text]
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"AddSubnetArns" 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]
addSubnetArns,
            (Key
"Options" 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 VpcOptions
options,
            (Key
"RemoveSubnetArns" 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]
removeSubnetArns
          ]
      )

instance Data.ToPath UpdateVpcAttachment where
  toPath :: UpdateVpcAttachment -> ByteString
toPath UpdateVpcAttachment' {Maybe [Text]
Maybe VpcOptions
Text
attachmentId :: Text
removeSubnetArns :: Maybe [Text]
options :: Maybe VpcOptions
addSubnetArns :: Maybe [Text]
$sel:attachmentId:UpdateVpcAttachment' :: UpdateVpcAttachment -> Text
$sel:removeSubnetArns:UpdateVpcAttachment' :: UpdateVpcAttachment -> Maybe [Text]
$sel:options:UpdateVpcAttachment' :: UpdateVpcAttachment -> Maybe VpcOptions
$sel:addSubnetArns:UpdateVpcAttachment' :: UpdateVpcAttachment -> Maybe [Text]
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ByteString
"/vpc-attachments/", forall a. ToByteString a => a -> ByteString
Data.toBS Text
attachmentId]

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

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

-- |
-- Create a value of 'UpdateVpcAttachmentResponse' 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:
--
-- 'vpcAttachment', 'updateVpcAttachmentResponse_vpcAttachment' - Describes the updated VPC attachment.
--
-- 'httpStatus', 'updateVpcAttachmentResponse_httpStatus' - The response's http status code.
newUpdateVpcAttachmentResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  UpdateVpcAttachmentResponse
newUpdateVpcAttachmentResponse :: Int -> UpdateVpcAttachmentResponse
newUpdateVpcAttachmentResponse Int
pHttpStatus_ =
  UpdateVpcAttachmentResponse'
    { $sel:vpcAttachment:UpdateVpcAttachmentResponse' :: Maybe VpcAttachment
vpcAttachment =
        forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:UpdateVpcAttachmentResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | Describes the updated VPC attachment.
updateVpcAttachmentResponse_vpcAttachment :: Lens.Lens' UpdateVpcAttachmentResponse (Prelude.Maybe VpcAttachment)
updateVpcAttachmentResponse_vpcAttachment :: Lens' UpdateVpcAttachmentResponse (Maybe VpcAttachment)
updateVpcAttachmentResponse_vpcAttachment = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateVpcAttachmentResponse' {Maybe VpcAttachment
vpcAttachment :: Maybe VpcAttachment
$sel:vpcAttachment:UpdateVpcAttachmentResponse' :: UpdateVpcAttachmentResponse -> Maybe VpcAttachment
vpcAttachment} -> Maybe VpcAttachment
vpcAttachment) (\s :: UpdateVpcAttachmentResponse
s@UpdateVpcAttachmentResponse' {} Maybe VpcAttachment
a -> UpdateVpcAttachmentResponse
s {$sel:vpcAttachment:UpdateVpcAttachmentResponse' :: Maybe VpcAttachment
vpcAttachment = Maybe VpcAttachment
a} :: UpdateVpcAttachmentResponse)

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

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