{-# 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.ModifyVpcAttribute
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Modifies the specified attribute of the specified VPC.
module Amazonka.EC2.ModifyVpcAttribute
  ( -- * Creating a Request
    ModifyVpcAttribute (..),
    newModifyVpcAttribute,

    -- * Request Lenses
    modifyVpcAttribute_enableDnsHostnames,
    modifyVpcAttribute_enableDnsSupport,
    modifyVpcAttribute_enableNetworkAddressUsageMetrics,
    modifyVpcAttribute_vpcId,

    -- * Destructuring the Response
    ModifyVpcAttributeResponse (..),
    newModifyVpcAttributeResponse,
  )
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:/ 'newModifyVpcAttribute' smart constructor.
data ModifyVpcAttribute = ModifyVpcAttribute'
  { -- | Indicates whether the instances launched in the VPC get DNS hostnames.
    -- If enabled, instances in the VPC get DNS hostnames; otherwise, they do
    -- not.
    --
    -- You cannot modify the DNS resolution and DNS hostnames attributes in the
    -- same request. Use separate requests for each attribute. You can only
    -- enable DNS hostnames if you\'ve enabled DNS support.
    ModifyVpcAttribute -> Maybe AttributeBooleanValue
enableDnsHostnames :: Prelude.Maybe AttributeBooleanValue,
    -- | Indicates whether the DNS resolution is supported for the VPC. If
    -- enabled, queries to the Amazon provided DNS server at the
    -- 169.254.169.253 IP address, or the reserved IP address at the base of
    -- the VPC network range \"plus two\" succeed. If disabled, the Amazon
    -- provided DNS service in the VPC that resolves public DNS hostnames to IP
    -- addresses is not enabled.
    --
    -- You cannot modify the DNS resolution and DNS hostnames attributes in the
    -- same request. Use separate requests for each attribute.
    ModifyVpcAttribute -> Maybe AttributeBooleanValue
enableDnsSupport :: Prelude.Maybe AttributeBooleanValue,
    -- | Indicates whether Network Address Usage metrics are enabled for your
    -- VPC.
    ModifyVpcAttribute -> Maybe AttributeBooleanValue
enableNetworkAddressUsageMetrics :: Prelude.Maybe AttributeBooleanValue,
    -- | The ID of the VPC.
    ModifyVpcAttribute -> Text
vpcId :: Prelude.Text
  }
  deriving (ModifyVpcAttribute -> ModifyVpcAttribute -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ModifyVpcAttribute -> ModifyVpcAttribute -> Bool
$c/= :: ModifyVpcAttribute -> ModifyVpcAttribute -> Bool
== :: ModifyVpcAttribute -> ModifyVpcAttribute -> Bool
$c== :: ModifyVpcAttribute -> ModifyVpcAttribute -> Bool
Prelude.Eq, ReadPrec [ModifyVpcAttribute]
ReadPrec ModifyVpcAttribute
Int -> ReadS ModifyVpcAttribute
ReadS [ModifyVpcAttribute]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ModifyVpcAttribute]
$creadListPrec :: ReadPrec [ModifyVpcAttribute]
readPrec :: ReadPrec ModifyVpcAttribute
$creadPrec :: ReadPrec ModifyVpcAttribute
readList :: ReadS [ModifyVpcAttribute]
$creadList :: ReadS [ModifyVpcAttribute]
readsPrec :: Int -> ReadS ModifyVpcAttribute
$creadsPrec :: Int -> ReadS ModifyVpcAttribute
Prelude.Read, Int -> ModifyVpcAttribute -> ShowS
[ModifyVpcAttribute] -> ShowS
ModifyVpcAttribute -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ModifyVpcAttribute] -> ShowS
$cshowList :: [ModifyVpcAttribute] -> ShowS
show :: ModifyVpcAttribute -> String
$cshow :: ModifyVpcAttribute -> String
showsPrec :: Int -> ModifyVpcAttribute -> ShowS
$cshowsPrec :: Int -> ModifyVpcAttribute -> ShowS
Prelude.Show, forall x. Rep ModifyVpcAttribute x -> ModifyVpcAttribute
forall x. ModifyVpcAttribute -> Rep ModifyVpcAttribute x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ModifyVpcAttribute x -> ModifyVpcAttribute
$cfrom :: forall x. ModifyVpcAttribute -> Rep ModifyVpcAttribute x
Prelude.Generic)

-- |
-- Create a value of 'ModifyVpcAttribute' 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:
--
-- 'enableDnsHostnames', 'modifyVpcAttribute_enableDnsHostnames' - Indicates whether the instances launched in the VPC get DNS hostnames.
-- If enabled, instances in the VPC get DNS hostnames; otherwise, they do
-- not.
--
-- You cannot modify the DNS resolution and DNS hostnames attributes in the
-- same request. Use separate requests for each attribute. You can only
-- enable DNS hostnames if you\'ve enabled DNS support.
--
-- 'enableDnsSupport', 'modifyVpcAttribute_enableDnsSupport' - Indicates whether the DNS resolution is supported for the VPC. If
-- enabled, queries to the Amazon provided DNS server at the
-- 169.254.169.253 IP address, or the reserved IP address at the base of
-- the VPC network range \"plus two\" succeed. If disabled, the Amazon
-- provided DNS service in the VPC that resolves public DNS hostnames to IP
-- addresses is not enabled.
--
-- You cannot modify the DNS resolution and DNS hostnames attributes in the
-- same request. Use separate requests for each attribute.
--
-- 'enableNetworkAddressUsageMetrics', 'modifyVpcAttribute_enableNetworkAddressUsageMetrics' - Indicates whether Network Address Usage metrics are enabled for your
-- VPC.
--
-- 'vpcId', 'modifyVpcAttribute_vpcId' - The ID of the VPC.
newModifyVpcAttribute ::
  -- | 'vpcId'
  Prelude.Text ->
  ModifyVpcAttribute
newModifyVpcAttribute :: Text -> ModifyVpcAttribute
newModifyVpcAttribute Text
pVpcId_ =
  ModifyVpcAttribute'
    { $sel:enableDnsHostnames:ModifyVpcAttribute' :: Maybe AttributeBooleanValue
enableDnsHostnames =
        forall a. Maybe a
Prelude.Nothing,
      $sel:enableDnsSupport:ModifyVpcAttribute' :: Maybe AttributeBooleanValue
enableDnsSupport = forall a. Maybe a
Prelude.Nothing,
      $sel:enableNetworkAddressUsageMetrics:ModifyVpcAttribute' :: Maybe AttributeBooleanValue
enableNetworkAddressUsageMetrics = forall a. Maybe a
Prelude.Nothing,
      $sel:vpcId:ModifyVpcAttribute' :: Text
vpcId = Text
pVpcId_
    }

-- | Indicates whether the instances launched in the VPC get DNS hostnames.
-- If enabled, instances in the VPC get DNS hostnames; otherwise, they do
-- not.
--
-- You cannot modify the DNS resolution and DNS hostnames attributes in the
-- same request. Use separate requests for each attribute. You can only
-- enable DNS hostnames if you\'ve enabled DNS support.
modifyVpcAttribute_enableDnsHostnames :: Lens.Lens' ModifyVpcAttribute (Prelude.Maybe AttributeBooleanValue)
modifyVpcAttribute_enableDnsHostnames :: Lens' ModifyVpcAttribute (Maybe AttributeBooleanValue)
modifyVpcAttribute_enableDnsHostnames = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ModifyVpcAttribute' {Maybe AttributeBooleanValue
enableDnsHostnames :: Maybe AttributeBooleanValue
$sel:enableDnsHostnames:ModifyVpcAttribute' :: ModifyVpcAttribute -> Maybe AttributeBooleanValue
enableDnsHostnames} -> Maybe AttributeBooleanValue
enableDnsHostnames) (\s :: ModifyVpcAttribute
s@ModifyVpcAttribute' {} Maybe AttributeBooleanValue
a -> ModifyVpcAttribute
s {$sel:enableDnsHostnames:ModifyVpcAttribute' :: Maybe AttributeBooleanValue
enableDnsHostnames = Maybe AttributeBooleanValue
a} :: ModifyVpcAttribute)

-- | Indicates whether the DNS resolution is supported for the VPC. If
-- enabled, queries to the Amazon provided DNS server at the
-- 169.254.169.253 IP address, or the reserved IP address at the base of
-- the VPC network range \"plus two\" succeed. If disabled, the Amazon
-- provided DNS service in the VPC that resolves public DNS hostnames to IP
-- addresses is not enabled.
--
-- You cannot modify the DNS resolution and DNS hostnames attributes in the
-- same request. Use separate requests for each attribute.
modifyVpcAttribute_enableDnsSupport :: Lens.Lens' ModifyVpcAttribute (Prelude.Maybe AttributeBooleanValue)
modifyVpcAttribute_enableDnsSupport :: Lens' ModifyVpcAttribute (Maybe AttributeBooleanValue)
modifyVpcAttribute_enableDnsSupport = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ModifyVpcAttribute' {Maybe AttributeBooleanValue
enableDnsSupport :: Maybe AttributeBooleanValue
$sel:enableDnsSupport:ModifyVpcAttribute' :: ModifyVpcAttribute -> Maybe AttributeBooleanValue
enableDnsSupport} -> Maybe AttributeBooleanValue
enableDnsSupport) (\s :: ModifyVpcAttribute
s@ModifyVpcAttribute' {} Maybe AttributeBooleanValue
a -> ModifyVpcAttribute
s {$sel:enableDnsSupport:ModifyVpcAttribute' :: Maybe AttributeBooleanValue
enableDnsSupport = Maybe AttributeBooleanValue
a} :: ModifyVpcAttribute)

-- | Indicates whether Network Address Usage metrics are enabled for your
-- VPC.
modifyVpcAttribute_enableNetworkAddressUsageMetrics :: Lens.Lens' ModifyVpcAttribute (Prelude.Maybe AttributeBooleanValue)
modifyVpcAttribute_enableNetworkAddressUsageMetrics :: Lens' ModifyVpcAttribute (Maybe AttributeBooleanValue)
modifyVpcAttribute_enableNetworkAddressUsageMetrics = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ModifyVpcAttribute' {Maybe AttributeBooleanValue
enableNetworkAddressUsageMetrics :: Maybe AttributeBooleanValue
$sel:enableNetworkAddressUsageMetrics:ModifyVpcAttribute' :: ModifyVpcAttribute -> Maybe AttributeBooleanValue
enableNetworkAddressUsageMetrics} -> Maybe AttributeBooleanValue
enableNetworkAddressUsageMetrics) (\s :: ModifyVpcAttribute
s@ModifyVpcAttribute' {} Maybe AttributeBooleanValue
a -> ModifyVpcAttribute
s {$sel:enableNetworkAddressUsageMetrics:ModifyVpcAttribute' :: Maybe AttributeBooleanValue
enableNetworkAddressUsageMetrics = Maybe AttributeBooleanValue
a} :: ModifyVpcAttribute)

-- | The ID of the VPC.
modifyVpcAttribute_vpcId :: Lens.Lens' ModifyVpcAttribute Prelude.Text
modifyVpcAttribute_vpcId :: Lens' ModifyVpcAttribute Text
modifyVpcAttribute_vpcId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ModifyVpcAttribute' {Text
vpcId :: Text
$sel:vpcId:ModifyVpcAttribute' :: ModifyVpcAttribute -> Text
vpcId} -> Text
vpcId) (\s :: ModifyVpcAttribute
s@ModifyVpcAttribute' {} Text
a -> ModifyVpcAttribute
s {$sel:vpcId:ModifyVpcAttribute' :: Text
vpcId = Text
a} :: ModifyVpcAttribute)

instance Core.AWSRequest ModifyVpcAttribute where
  type
    AWSResponse ModifyVpcAttribute =
      ModifyVpcAttributeResponse
  request :: (Service -> Service)
-> ModifyVpcAttribute -> Request ModifyVpcAttribute
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 ModifyVpcAttribute
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse ModifyVpcAttribute)))
response =
    forall (m :: * -> *) a.
MonadResource m =>
AWSResponse a
-> (ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy a
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse a)))
Response.receiveNull ModifyVpcAttributeResponse
ModifyVpcAttributeResponse'

instance Prelude.Hashable ModifyVpcAttribute where
  hashWithSalt :: Int -> ModifyVpcAttribute -> Int
hashWithSalt Int
_salt ModifyVpcAttribute' {Maybe AttributeBooleanValue
Text
vpcId :: Text
enableNetworkAddressUsageMetrics :: Maybe AttributeBooleanValue
enableDnsSupport :: Maybe AttributeBooleanValue
enableDnsHostnames :: Maybe AttributeBooleanValue
$sel:vpcId:ModifyVpcAttribute' :: ModifyVpcAttribute -> Text
$sel:enableNetworkAddressUsageMetrics:ModifyVpcAttribute' :: ModifyVpcAttribute -> Maybe AttributeBooleanValue
$sel:enableDnsSupport:ModifyVpcAttribute' :: ModifyVpcAttribute -> Maybe AttributeBooleanValue
$sel:enableDnsHostnames:ModifyVpcAttribute' :: ModifyVpcAttribute -> Maybe AttributeBooleanValue
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe AttributeBooleanValue
enableDnsHostnames
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe AttributeBooleanValue
enableDnsSupport
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe AttributeBooleanValue
enableNetworkAddressUsageMetrics
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
vpcId

instance Prelude.NFData ModifyVpcAttribute where
  rnf :: ModifyVpcAttribute -> ()
rnf ModifyVpcAttribute' {Maybe AttributeBooleanValue
Text
vpcId :: Text
enableNetworkAddressUsageMetrics :: Maybe AttributeBooleanValue
enableDnsSupport :: Maybe AttributeBooleanValue
enableDnsHostnames :: Maybe AttributeBooleanValue
$sel:vpcId:ModifyVpcAttribute' :: ModifyVpcAttribute -> Text
$sel:enableNetworkAddressUsageMetrics:ModifyVpcAttribute' :: ModifyVpcAttribute -> Maybe AttributeBooleanValue
$sel:enableDnsSupport:ModifyVpcAttribute' :: ModifyVpcAttribute -> Maybe AttributeBooleanValue
$sel:enableDnsHostnames:ModifyVpcAttribute' :: ModifyVpcAttribute -> Maybe AttributeBooleanValue
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe AttributeBooleanValue
enableDnsHostnames
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe AttributeBooleanValue
enableDnsSupport
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe AttributeBooleanValue
enableNetworkAddressUsageMetrics
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
vpcId

instance Data.ToHeaders ModifyVpcAttribute where
  toHeaders :: ModifyVpcAttribute -> [Header]
toHeaders = forall a b. a -> b -> a
Prelude.const forall a. Monoid a => a
Prelude.mempty

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

instance Data.ToQuery ModifyVpcAttribute where
  toQuery :: ModifyVpcAttribute -> QueryString
toQuery ModifyVpcAttribute' {Maybe AttributeBooleanValue
Text
vpcId :: Text
enableNetworkAddressUsageMetrics :: Maybe AttributeBooleanValue
enableDnsSupport :: Maybe AttributeBooleanValue
enableDnsHostnames :: Maybe AttributeBooleanValue
$sel:vpcId:ModifyVpcAttribute' :: ModifyVpcAttribute -> Text
$sel:enableNetworkAddressUsageMetrics:ModifyVpcAttribute' :: ModifyVpcAttribute -> Maybe AttributeBooleanValue
$sel:enableDnsSupport:ModifyVpcAttribute' :: ModifyVpcAttribute -> Maybe AttributeBooleanValue
$sel:enableDnsHostnames:ModifyVpcAttribute' :: ModifyVpcAttribute -> Maybe AttributeBooleanValue
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"Action"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: (ByteString
"ModifyVpcAttribute" :: Prelude.ByteString),
        ByteString
"Version"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: (ByteString
"2016-11-15" :: Prelude.ByteString),
        ByteString
"EnableDnsHostnames" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe AttributeBooleanValue
enableDnsHostnames,
        ByteString
"EnableDnsSupport" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe AttributeBooleanValue
enableDnsSupport,
        ByteString
"EnableNetworkAddressUsageMetrics"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe AttributeBooleanValue
enableNetworkAddressUsageMetrics,
        ByteString
"VpcId" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Text
vpcId
      ]

-- | /See:/ 'newModifyVpcAttributeResponse' smart constructor.
data ModifyVpcAttributeResponse = ModifyVpcAttributeResponse'
  {
  }
  deriving (ModifyVpcAttributeResponse -> ModifyVpcAttributeResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ModifyVpcAttributeResponse -> ModifyVpcAttributeResponse -> Bool
$c/= :: ModifyVpcAttributeResponse -> ModifyVpcAttributeResponse -> Bool
== :: ModifyVpcAttributeResponse -> ModifyVpcAttributeResponse -> Bool
$c== :: ModifyVpcAttributeResponse -> ModifyVpcAttributeResponse -> Bool
Prelude.Eq, ReadPrec [ModifyVpcAttributeResponse]
ReadPrec ModifyVpcAttributeResponse
Int -> ReadS ModifyVpcAttributeResponse
ReadS [ModifyVpcAttributeResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ModifyVpcAttributeResponse]
$creadListPrec :: ReadPrec [ModifyVpcAttributeResponse]
readPrec :: ReadPrec ModifyVpcAttributeResponse
$creadPrec :: ReadPrec ModifyVpcAttributeResponse
readList :: ReadS [ModifyVpcAttributeResponse]
$creadList :: ReadS [ModifyVpcAttributeResponse]
readsPrec :: Int -> ReadS ModifyVpcAttributeResponse
$creadsPrec :: Int -> ReadS ModifyVpcAttributeResponse
Prelude.Read, Int -> ModifyVpcAttributeResponse -> ShowS
[ModifyVpcAttributeResponse] -> ShowS
ModifyVpcAttributeResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ModifyVpcAttributeResponse] -> ShowS
$cshowList :: [ModifyVpcAttributeResponse] -> ShowS
show :: ModifyVpcAttributeResponse -> String
$cshow :: ModifyVpcAttributeResponse -> String
showsPrec :: Int -> ModifyVpcAttributeResponse -> ShowS
$cshowsPrec :: Int -> ModifyVpcAttributeResponse -> ShowS
Prelude.Show, forall x.
Rep ModifyVpcAttributeResponse x -> ModifyVpcAttributeResponse
forall x.
ModifyVpcAttributeResponse -> Rep ModifyVpcAttributeResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep ModifyVpcAttributeResponse x -> ModifyVpcAttributeResponse
$cfrom :: forall x.
ModifyVpcAttributeResponse -> Rep ModifyVpcAttributeResponse x
Prelude.Generic)

-- |
-- Create a value of 'ModifyVpcAttributeResponse' 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.
newModifyVpcAttributeResponse ::
  ModifyVpcAttributeResponse
newModifyVpcAttributeResponse :: ModifyVpcAttributeResponse
newModifyVpcAttributeResponse =
  ModifyVpcAttributeResponse
ModifyVpcAttributeResponse'

instance Prelude.NFData ModifyVpcAttributeResponse where
  rnf :: ModifyVpcAttributeResponse -> ()
rnf ModifyVpcAttributeResponse
_ = ()