{-# 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.CreateVpc
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Creates a VPC with the specified IPv4 CIDR block. The smallest VPC you
-- can create uses a \/28 netmask (16 IPv4 addresses), and the largest uses
-- a \/16 netmask (65,536 IPv4 addresses). For more information about how
-- large to make your VPC, see
-- <https://docs.aws.amazon.com/vpc/latest/userguide/VPC_Subnets.html Your VPC and subnets>
-- in the /Amazon Virtual Private Cloud User Guide/.
--
-- You can optionally request an IPv6 CIDR block for the VPC. You can
-- request an Amazon-provided IPv6 CIDR block from Amazon\'s pool of IPv6
-- addresses, or an IPv6 CIDR block from an IPv6 address pool that you
-- provisioned through bring your own IP addresses
-- (<https://docs.aws.amazon.com/AWSEC2/latest/UserGuide/ec2-byoip.html BYOIP>).
--
-- By default, each instance you launch in the VPC has the default DHCP
-- options, which include only a default DNS server that we provide
-- (AmazonProvidedDNS). For more information, see
-- <https://docs.aws.amazon.com/vpc/latest/userguide/VPC_DHCP_Options.html DHCP options sets>
-- in the /Amazon Virtual Private Cloud User Guide/.
--
-- You can specify the instance tenancy value for the VPC when you create
-- it. You can\'t change this value for the VPC after you create it. For
-- more information, see
-- <https://docs.aws.amazon.com/AWSEC2/latest/UserGuide/dedicated-instance.html Dedicated Instances>
-- in the /Amazon Elastic Compute Cloud User Guide/.
module Amazonka.EC2.CreateVpc
  ( -- * Creating a Request
    CreateVpc (..),
    newCreateVpc,

    -- * Request Lenses
    createVpc_amazonProvidedIpv6CidrBlock,
    createVpc_cidrBlock,
    createVpc_dryRun,
    createVpc_instanceTenancy,
    createVpc_ipv4IpamPoolId,
    createVpc_ipv4NetmaskLength,
    createVpc_ipv6CidrBlock,
    createVpc_ipv6CidrBlockNetworkBorderGroup,
    createVpc_ipv6IpamPoolId,
    createVpc_ipv6NetmaskLength,
    createVpc_ipv6Pool,
    createVpc_tagSpecifications,

    -- * Destructuring the Response
    CreateVpcResponse (..),
    newCreateVpcResponse,

    -- * Response Lenses
    createVpcResponse_vpc,
    createVpcResponse_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:/ 'newCreateVpc' smart constructor.
data CreateVpc = CreateVpc'
  { -- | Requests an Amazon-provided IPv6 CIDR block with a \/56 prefix length
    -- for the VPC. You cannot specify the range of IP addresses, or the size
    -- of the CIDR block.
    CreateVpc -> Maybe Bool
amazonProvidedIpv6CidrBlock :: Prelude.Maybe Prelude.Bool,
    -- | The IPv4 network range for the VPC, in CIDR notation. For example,
    -- @10.0.0.0\/16@. We modify the specified CIDR block to its canonical
    -- form; for example, if you specify @100.68.0.18\/18@, we modify it to
    -- @100.68.0.0\/18@.
    CreateVpc -> Maybe Text
cidrBlock :: Prelude.Maybe Prelude.Text,
    -- | 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@.
    CreateVpc -> Maybe Bool
dryRun :: Prelude.Maybe Prelude.Bool,
    -- | The tenancy options for instances launched into the VPC. For @default@,
    -- instances are launched with shared tenancy by default. You can launch
    -- instances with any tenancy into a shared tenancy VPC. For @dedicated@,
    -- instances are launched as dedicated tenancy instances by default. You
    -- can only launch instances with a tenancy of @dedicated@ or @host@ into a
    -- dedicated tenancy VPC.
    --
    -- __Important:__ The @host@ value cannot be used with this parameter. Use
    -- the @default@ or @dedicated@ values only.
    --
    -- Default: @default@
    CreateVpc -> Maybe Tenancy
instanceTenancy :: Prelude.Maybe Tenancy,
    -- | The ID of an IPv4 IPAM pool you want to use for allocating this VPC\'s
    -- CIDR. For more information, see
    -- <https://docs.aws.amazon.com/vpc/latest/ipam/what-is-it-ipam.html What is IPAM?>
    -- in the /Amazon VPC IPAM User Guide/.
    CreateVpc -> Maybe Text
ipv4IpamPoolId :: Prelude.Maybe Prelude.Text,
    -- | The netmask length of the IPv4 CIDR you want to allocate to this VPC
    -- from an Amazon VPC IP Address Manager (IPAM) pool. For more information
    -- about IPAM, see
    -- <https://docs.aws.amazon.com/vpc/latest/ipam/what-is-it-ipam.html What is IPAM?>
    -- in the /Amazon VPC IPAM User Guide/.
    CreateVpc -> Maybe Int
ipv4NetmaskLength :: Prelude.Maybe Prelude.Int,
    -- | The IPv6 CIDR block from the IPv6 address pool. You must also specify
    -- @Ipv6Pool@ in the request.
    --
    -- To let Amazon choose the IPv6 CIDR block for you, omit this parameter.
    CreateVpc -> Maybe Text
ipv6CidrBlock :: Prelude.Maybe Prelude.Text,
    -- | The name of the location from which we advertise the IPV6 CIDR block.
    -- Use this parameter to limit the address to this location.
    --
    -- You must set @AmazonProvidedIpv6CidrBlock@ to @true@ to use this
    -- parameter.
    CreateVpc -> Maybe Text
ipv6CidrBlockNetworkBorderGroup :: Prelude.Maybe Prelude.Text,
    -- | The ID of an IPv6 IPAM pool which will be used to allocate this VPC an
    -- IPv6 CIDR. IPAM is a VPC feature that you can use to automate your IP
    -- address management workflows including assigning, tracking,
    -- troubleshooting, and auditing IP addresses across Amazon Web Services
    -- Regions and accounts throughout your Amazon Web Services Organization.
    -- For more information, see
    -- <https://docs.aws.amazon.com/vpc/latest/ipam/what-is-it-ipam.html What is IPAM?>
    -- in the /Amazon VPC IPAM User Guide/.
    CreateVpc -> Maybe Text
ipv6IpamPoolId :: Prelude.Maybe Prelude.Text,
    -- | The netmask length of the IPv6 CIDR you want to allocate to this VPC
    -- from an Amazon VPC IP Address Manager (IPAM) pool. For more information
    -- about IPAM, see
    -- <https://docs.aws.amazon.com/vpc/latest/ipam/what-is-it-ipam.html What is IPAM?>
    -- in the /Amazon VPC IPAM User Guide/.
    CreateVpc -> Maybe Int
ipv6NetmaskLength :: Prelude.Maybe Prelude.Int,
    -- | The ID of an IPv6 address pool from which to allocate the IPv6 CIDR
    -- block.
    CreateVpc -> Maybe Text
ipv6Pool :: Prelude.Maybe Prelude.Text,
    -- | The tags to assign to the VPC.
    CreateVpc -> Maybe [TagSpecification]
tagSpecifications :: Prelude.Maybe [TagSpecification]
  }
  deriving (CreateVpc -> CreateVpc -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateVpc -> CreateVpc -> Bool
$c/= :: CreateVpc -> CreateVpc -> Bool
== :: CreateVpc -> CreateVpc -> Bool
$c== :: CreateVpc -> CreateVpc -> Bool
Prelude.Eq, ReadPrec [CreateVpc]
ReadPrec CreateVpc
Int -> ReadS CreateVpc
ReadS [CreateVpc]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CreateVpc]
$creadListPrec :: ReadPrec [CreateVpc]
readPrec :: ReadPrec CreateVpc
$creadPrec :: ReadPrec CreateVpc
readList :: ReadS [CreateVpc]
$creadList :: ReadS [CreateVpc]
readsPrec :: Int -> ReadS CreateVpc
$creadsPrec :: Int -> ReadS CreateVpc
Prelude.Read, Int -> CreateVpc -> ShowS
[CreateVpc] -> ShowS
CreateVpc -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateVpc] -> ShowS
$cshowList :: [CreateVpc] -> ShowS
show :: CreateVpc -> String
$cshow :: CreateVpc -> String
showsPrec :: Int -> CreateVpc -> ShowS
$cshowsPrec :: Int -> CreateVpc -> ShowS
Prelude.Show, forall x. Rep CreateVpc x -> CreateVpc
forall x. CreateVpc -> Rep CreateVpc x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CreateVpc x -> CreateVpc
$cfrom :: forall x. CreateVpc -> Rep CreateVpc x
Prelude.Generic)

-- |
-- Create a value of 'CreateVpc' 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:
--
-- 'amazonProvidedIpv6CidrBlock', 'createVpc_amazonProvidedIpv6CidrBlock' - Requests an Amazon-provided IPv6 CIDR block with a \/56 prefix length
-- for the VPC. You cannot specify the range of IP addresses, or the size
-- of the CIDR block.
--
-- 'cidrBlock', 'createVpc_cidrBlock' - The IPv4 network range for the VPC, in CIDR notation. For example,
-- @10.0.0.0\/16@. We modify the specified CIDR block to its canonical
-- form; for example, if you specify @100.68.0.18\/18@, we modify it to
-- @100.68.0.0\/18@.
--
-- 'dryRun', 'createVpc_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@.
--
-- 'instanceTenancy', 'createVpc_instanceTenancy' - The tenancy options for instances launched into the VPC. For @default@,
-- instances are launched with shared tenancy by default. You can launch
-- instances with any tenancy into a shared tenancy VPC. For @dedicated@,
-- instances are launched as dedicated tenancy instances by default. You
-- can only launch instances with a tenancy of @dedicated@ or @host@ into a
-- dedicated tenancy VPC.
--
-- __Important:__ The @host@ value cannot be used with this parameter. Use
-- the @default@ or @dedicated@ values only.
--
-- Default: @default@
--
-- 'ipv4IpamPoolId', 'createVpc_ipv4IpamPoolId' - The ID of an IPv4 IPAM pool you want to use for allocating this VPC\'s
-- CIDR. For more information, see
-- <https://docs.aws.amazon.com/vpc/latest/ipam/what-is-it-ipam.html What is IPAM?>
-- in the /Amazon VPC IPAM User Guide/.
--
-- 'ipv4NetmaskLength', 'createVpc_ipv4NetmaskLength' - The netmask length of the IPv4 CIDR you want to allocate to this VPC
-- from an Amazon VPC IP Address Manager (IPAM) pool. For more information
-- about IPAM, see
-- <https://docs.aws.amazon.com/vpc/latest/ipam/what-is-it-ipam.html What is IPAM?>
-- in the /Amazon VPC IPAM User Guide/.
--
-- 'ipv6CidrBlock', 'createVpc_ipv6CidrBlock' - The IPv6 CIDR block from the IPv6 address pool. You must also specify
-- @Ipv6Pool@ in the request.
--
-- To let Amazon choose the IPv6 CIDR block for you, omit this parameter.
--
-- 'ipv6CidrBlockNetworkBorderGroup', 'createVpc_ipv6CidrBlockNetworkBorderGroup' - The name of the location from which we advertise the IPV6 CIDR block.
-- Use this parameter to limit the address to this location.
--
-- You must set @AmazonProvidedIpv6CidrBlock@ to @true@ to use this
-- parameter.
--
-- 'ipv6IpamPoolId', 'createVpc_ipv6IpamPoolId' - The ID of an IPv6 IPAM pool which will be used to allocate this VPC an
-- IPv6 CIDR. IPAM is a VPC feature that you can use to automate your IP
-- address management workflows including assigning, tracking,
-- troubleshooting, and auditing IP addresses across Amazon Web Services
-- Regions and accounts throughout your Amazon Web Services Organization.
-- For more information, see
-- <https://docs.aws.amazon.com/vpc/latest/ipam/what-is-it-ipam.html What is IPAM?>
-- in the /Amazon VPC IPAM User Guide/.
--
-- 'ipv6NetmaskLength', 'createVpc_ipv6NetmaskLength' - The netmask length of the IPv6 CIDR you want to allocate to this VPC
-- from an Amazon VPC IP Address Manager (IPAM) pool. For more information
-- about IPAM, see
-- <https://docs.aws.amazon.com/vpc/latest/ipam/what-is-it-ipam.html What is IPAM?>
-- in the /Amazon VPC IPAM User Guide/.
--
-- 'ipv6Pool', 'createVpc_ipv6Pool' - The ID of an IPv6 address pool from which to allocate the IPv6 CIDR
-- block.
--
-- 'tagSpecifications', 'createVpc_tagSpecifications' - The tags to assign to the VPC.
newCreateVpc ::
  CreateVpc
newCreateVpc :: CreateVpc
newCreateVpc =
  CreateVpc'
    { $sel:amazonProvidedIpv6CidrBlock:CreateVpc' :: Maybe Bool
amazonProvidedIpv6CidrBlock =
        forall a. Maybe a
Prelude.Nothing,
      $sel:cidrBlock:CreateVpc' :: Maybe Text
cidrBlock = forall a. Maybe a
Prelude.Nothing,
      $sel:dryRun:CreateVpc' :: Maybe Bool
dryRun = forall a. Maybe a
Prelude.Nothing,
      $sel:instanceTenancy:CreateVpc' :: Maybe Tenancy
instanceTenancy = forall a. Maybe a
Prelude.Nothing,
      $sel:ipv4IpamPoolId:CreateVpc' :: Maybe Text
ipv4IpamPoolId = forall a. Maybe a
Prelude.Nothing,
      $sel:ipv4NetmaskLength:CreateVpc' :: Maybe Int
ipv4NetmaskLength = forall a. Maybe a
Prelude.Nothing,
      $sel:ipv6CidrBlock:CreateVpc' :: Maybe Text
ipv6CidrBlock = forall a. Maybe a
Prelude.Nothing,
      $sel:ipv6CidrBlockNetworkBorderGroup:CreateVpc' :: Maybe Text
ipv6CidrBlockNetworkBorderGroup = forall a. Maybe a
Prelude.Nothing,
      $sel:ipv6IpamPoolId:CreateVpc' :: Maybe Text
ipv6IpamPoolId = forall a. Maybe a
Prelude.Nothing,
      $sel:ipv6NetmaskLength:CreateVpc' :: Maybe Int
ipv6NetmaskLength = forall a. Maybe a
Prelude.Nothing,
      $sel:ipv6Pool:CreateVpc' :: Maybe Text
ipv6Pool = forall a. Maybe a
Prelude.Nothing,
      $sel:tagSpecifications:CreateVpc' :: Maybe [TagSpecification]
tagSpecifications = forall a. Maybe a
Prelude.Nothing
    }

-- | Requests an Amazon-provided IPv6 CIDR block with a \/56 prefix length
-- for the VPC. You cannot specify the range of IP addresses, or the size
-- of the CIDR block.
createVpc_amazonProvidedIpv6CidrBlock :: Lens.Lens' CreateVpc (Prelude.Maybe Prelude.Bool)
createVpc_amazonProvidedIpv6CidrBlock :: Lens' CreateVpc (Maybe Bool)
createVpc_amazonProvidedIpv6CidrBlock = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateVpc' {Maybe Bool
amazonProvidedIpv6CidrBlock :: Maybe Bool
$sel:amazonProvidedIpv6CidrBlock:CreateVpc' :: CreateVpc -> Maybe Bool
amazonProvidedIpv6CidrBlock} -> Maybe Bool
amazonProvidedIpv6CidrBlock) (\s :: CreateVpc
s@CreateVpc' {} Maybe Bool
a -> CreateVpc
s {$sel:amazonProvidedIpv6CidrBlock:CreateVpc' :: Maybe Bool
amazonProvidedIpv6CidrBlock = Maybe Bool
a} :: CreateVpc)

-- | The IPv4 network range for the VPC, in CIDR notation. For example,
-- @10.0.0.0\/16@. We modify the specified CIDR block to its canonical
-- form; for example, if you specify @100.68.0.18\/18@, we modify it to
-- @100.68.0.0\/18@.
createVpc_cidrBlock :: Lens.Lens' CreateVpc (Prelude.Maybe Prelude.Text)
createVpc_cidrBlock :: Lens' CreateVpc (Maybe Text)
createVpc_cidrBlock = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateVpc' {Maybe Text
cidrBlock :: Maybe Text
$sel:cidrBlock:CreateVpc' :: CreateVpc -> Maybe Text
cidrBlock} -> Maybe Text
cidrBlock) (\s :: CreateVpc
s@CreateVpc' {} Maybe Text
a -> CreateVpc
s {$sel:cidrBlock:CreateVpc' :: Maybe Text
cidrBlock = Maybe Text
a} :: CreateVpc)

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

-- | The tenancy options for instances launched into the VPC. For @default@,
-- instances are launched with shared tenancy by default. You can launch
-- instances with any tenancy into a shared tenancy VPC. For @dedicated@,
-- instances are launched as dedicated tenancy instances by default. You
-- can only launch instances with a tenancy of @dedicated@ or @host@ into a
-- dedicated tenancy VPC.
--
-- __Important:__ The @host@ value cannot be used with this parameter. Use
-- the @default@ or @dedicated@ values only.
--
-- Default: @default@
createVpc_instanceTenancy :: Lens.Lens' CreateVpc (Prelude.Maybe Tenancy)
createVpc_instanceTenancy :: Lens' CreateVpc (Maybe Tenancy)
createVpc_instanceTenancy = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateVpc' {Maybe Tenancy
instanceTenancy :: Maybe Tenancy
$sel:instanceTenancy:CreateVpc' :: CreateVpc -> Maybe Tenancy
instanceTenancy} -> Maybe Tenancy
instanceTenancy) (\s :: CreateVpc
s@CreateVpc' {} Maybe Tenancy
a -> CreateVpc
s {$sel:instanceTenancy:CreateVpc' :: Maybe Tenancy
instanceTenancy = Maybe Tenancy
a} :: CreateVpc)

-- | The ID of an IPv4 IPAM pool you want to use for allocating this VPC\'s
-- CIDR. For more information, see
-- <https://docs.aws.amazon.com/vpc/latest/ipam/what-is-it-ipam.html What is IPAM?>
-- in the /Amazon VPC IPAM User Guide/.
createVpc_ipv4IpamPoolId :: Lens.Lens' CreateVpc (Prelude.Maybe Prelude.Text)
createVpc_ipv4IpamPoolId :: Lens' CreateVpc (Maybe Text)
createVpc_ipv4IpamPoolId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateVpc' {Maybe Text
ipv4IpamPoolId :: Maybe Text
$sel:ipv4IpamPoolId:CreateVpc' :: CreateVpc -> Maybe Text
ipv4IpamPoolId} -> Maybe Text
ipv4IpamPoolId) (\s :: CreateVpc
s@CreateVpc' {} Maybe Text
a -> CreateVpc
s {$sel:ipv4IpamPoolId:CreateVpc' :: Maybe Text
ipv4IpamPoolId = Maybe Text
a} :: CreateVpc)

-- | The netmask length of the IPv4 CIDR you want to allocate to this VPC
-- from an Amazon VPC IP Address Manager (IPAM) pool. For more information
-- about IPAM, see
-- <https://docs.aws.amazon.com/vpc/latest/ipam/what-is-it-ipam.html What is IPAM?>
-- in the /Amazon VPC IPAM User Guide/.
createVpc_ipv4NetmaskLength :: Lens.Lens' CreateVpc (Prelude.Maybe Prelude.Int)
createVpc_ipv4NetmaskLength :: Lens' CreateVpc (Maybe Int)
createVpc_ipv4NetmaskLength = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateVpc' {Maybe Int
ipv4NetmaskLength :: Maybe Int
$sel:ipv4NetmaskLength:CreateVpc' :: CreateVpc -> Maybe Int
ipv4NetmaskLength} -> Maybe Int
ipv4NetmaskLength) (\s :: CreateVpc
s@CreateVpc' {} Maybe Int
a -> CreateVpc
s {$sel:ipv4NetmaskLength:CreateVpc' :: Maybe Int
ipv4NetmaskLength = Maybe Int
a} :: CreateVpc)

-- | The IPv6 CIDR block from the IPv6 address pool. You must also specify
-- @Ipv6Pool@ in the request.
--
-- To let Amazon choose the IPv6 CIDR block for you, omit this parameter.
createVpc_ipv6CidrBlock :: Lens.Lens' CreateVpc (Prelude.Maybe Prelude.Text)
createVpc_ipv6CidrBlock :: Lens' CreateVpc (Maybe Text)
createVpc_ipv6CidrBlock = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateVpc' {Maybe Text
ipv6CidrBlock :: Maybe Text
$sel:ipv6CidrBlock:CreateVpc' :: CreateVpc -> Maybe Text
ipv6CidrBlock} -> Maybe Text
ipv6CidrBlock) (\s :: CreateVpc
s@CreateVpc' {} Maybe Text
a -> CreateVpc
s {$sel:ipv6CidrBlock:CreateVpc' :: Maybe Text
ipv6CidrBlock = Maybe Text
a} :: CreateVpc)

-- | The name of the location from which we advertise the IPV6 CIDR block.
-- Use this parameter to limit the address to this location.
--
-- You must set @AmazonProvidedIpv6CidrBlock@ to @true@ to use this
-- parameter.
createVpc_ipv6CidrBlockNetworkBorderGroup :: Lens.Lens' CreateVpc (Prelude.Maybe Prelude.Text)
createVpc_ipv6CidrBlockNetworkBorderGroup :: Lens' CreateVpc (Maybe Text)
createVpc_ipv6CidrBlockNetworkBorderGroup = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateVpc' {Maybe Text
ipv6CidrBlockNetworkBorderGroup :: Maybe Text
$sel:ipv6CidrBlockNetworkBorderGroup:CreateVpc' :: CreateVpc -> Maybe Text
ipv6CidrBlockNetworkBorderGroup} -> Maybe Text
ipv6CidrBlockNetworkBorderGroup) (\s :: CreateVpc
s@CreateVpc' {} Maybe Text
a -> CreateVpc
s {$sel:ipv6CidrBlockNetworkBorderGroup:CreateVpc' :: Maybe Text
ipv6CidrBlockNetworkBorderGroup = Maybe Text
a} :: CreateVpc)

-- | The ID of an IPv6 IPAM pool which will be used to allocate this VPC an
-- IPv6 CIDR. IPAM is a VPC feature that you can use to automate your IP
-- address management workflows including assigning, tracking,
-- troubleshooting, and auditing IP addresses across Amazon Web Services
-- Regions and accounts throughout your Amazon Web Services Organization.
-- For more information, see
-- <https://docs.aws.amazon.com/vpc/latest/ipam/what-is-it-ipam.html What is IPAM?>
-- in the /Amazon VPC IPAM User Guide/.
createVpc_ipv6IpamPoolId :: Lens.Lens' CreateVpc (Prelude.Maybe Prelude.Text)
createVpc_ipv6IpamPoolId :: Lens' CreateVpc (Maybe Text)
createVpc_ipv6IpamPoolId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateVpc' {Maybe Text
ipv6IpamPoolId :: Maybe Text
$sel:ipv6IpamPoolId:CreateVpc' :: CreateVpc -> Maybe Text
ipv6IpamPoolId} -> Maybe Text
ipv6IpamPoolId) (\s :: CreateVpc
s@CreateVpc' {} Maybe Text
a -> CreateVpc
s {$sel:ipv6IpamPoolId:CreateVpc' :: Maybe Text
ipv6IpamPoolId = Maybe Text
a} :: CreateVpc)

-- | The netmask length of the IPv6 CIDR you want to allocate to this VPC
-- from an Amazon VPC IP Address Manager (IPAM) pool. For more information
-- about IPAM, see
-- <https://docs.aws.amazon.com/vpc/latest/ipam/what-is-it-ipam.html What is IPAM?>
-- in the /Amazon VPC IPAM User Guide/.
createVpc_ipv6NetmaskLength :: Lens.Lens' CreateVpc (Prelude.Maybe Prelude.Int)
createVpc_ipv6NetmaskLength :: Lens' CreateVpc (Maybe Int)
createVpc_ipv6NetmaskLength = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateVpc' {Maybe Int
ipv6NetmaskLength :: Maybe Int
$sel:ipv6NetmaskLength:CreateVpc' :: CreateVpc -> Maybe Int
ipv6NetmaskLength} -> Maybe Int
ipv6NetmaskLength) (\s :: CreateVpc
s@CreateVpc' {} Maybe Int
a -> CreateVpc
s {$sel:ipv6NetmaskLength:CreateVpc' :: Maybe Int
ipv6NetmaskLength = Maybe Int
a} :: CreateVpc)

-- | The ID of an IPv6 address pool from which to allocate the IPv6 CIDR
-- block.
createVpc_ipv6Pool :: Lens.Lens' CreateVpc (Prelude.Maybe Prelude.Text)
createVpc_ipv6Pool :: Lens' CreateVpc (Maybe Text)
createVpc_ipv6Pool = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateVpc' {Maybe Text
ipv6Pool :: Maybe Text
$sel:ipv6Pool:CreateVpc' :: CreateVpc -> Maybe Text
ipv6Pool} -> Maybe Text
ipv6Pool) (\s :: CreateVpc
s@CreateVpc' {} Maybe Text
a -> CreateVpc
s {$sel:ipv6Pool:CreateVpc' :: Maybe Text
ipv6Pool = Maybe Text
a} :: CreateVpc)

-- | The tags to assign to the VPC.
createVpc_tagSpecifications :: Lens.Lens' CreateVpc (Prelude.Maybe [TagSpecification])
createVpc_tagSpecifications :: Lens' CreateVpc (Maybe [TagSpecification])
createVpc_tagSpecifications = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateVpc' {Maybe [TagSpecification]
tagSpecifications :: Maybe [TagSpecification]
$sel:tagSpecifications:CreateVpc' :: CreateVpc -> Maybe [TagSpecification]
tagSpecifications} -> Maybe [TagSpecification]
tagSpecifications) (\s :: CreateVpc
s@CreateVpc' {} Maybe [TagSpecification]
a -> CreateVpc
s {$sel:tagSpecifications:CreateVpc' :: Maybe [TagSpecification]
tagSpecifications = Maybe [TagSpecification]
a} :: CreateVpc) 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

instance Core.AWSRequest CreateVpc where
  type AWSResponse CreateVpc = CreateVpcResponse
  request :: (Service -> Service) -> CreateVpc -> Request CreateVpc
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 CreateVpc
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse CreateVpc)))
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 Vpc -> Int -> CreateVpcResponse
CreateVpcResponse'
            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
"vpc")
            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 CreateVpc where
  hashWithSalt :: Int -> CreateVpc -> Int
hashWithSalt Int
_salt CreateVpc' {Maybe Bool
Maybe Int
Maybe [TagSpecification]
Maybe Text
Maybe Tenancy
tagSpecifications :: Maybe [TagSpecification]
ipv6Pool :: Maybe Text
ipv6NetmaskLength :: Maybe Int
ipv6IpamPoolId :: Maybe Text
ipv6CidrBlockNetworkBorderGroup :: Maybe Text
ipv6CidrBlock :: Maybe Text
ipv4NetmaskLength :: Maybe Int
ipv4IpamPoolId :: Maybe Text
instanceTenancy :: Maybe Tenancy
dryRun :: Maybe Bool
cidrBlock :: Maybe Text
amazonProvidedIpv6CidrBlock :: Maybe Bool
$sel:tagSpecifications:CreateVpc' :: CreateVpc -> Maybe [TagSpecification]
$sel:ipv6Pool:CreateVpc' :: CreateVpc -> Maybe Text
$sel:ipv6NetmaskLength:CreateVpc' :: CreateVpc -> Maybe Int
$sel:ipv6IpamPoolId:CreateVpc' :: CreateVpc -> Maybe Text
$sel:ipv6CidrBlockNetworkBorderGroup:CreateVpc' :: CreateVpc -> Maybe Text
$sel:ipv6CidrBlock:CreateVpc' :: CreateVpc -> Maybe Text
$sel:ipv4NetmaskLength:CreateVpc' :: CreateVpc -> Maybe Int
$sel:ipv4IpamPoolId:CreateVpc' :: CreateVpc -> Maybe Text
$sel:instanceTenancy:CreateVpc' :: CreateVpc -> Maybe Tenancy
$sel:dryRun:CreateVpc' :: CreateVpc -> Maybe Bool
$sel:cidrBlock:CreateVpc' :: CreateVpc -> Maybe Text
$sel:amazonProvidedIpv6CidrBlock:CreateVpc' :: CreateVpc -> Maybe Bool
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Bool
amazonProvidedIpv6CidrBlock
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
cidrBlock
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Bool
dryRun
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Tenancy
instanceTenancy
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
ipv4IpamPoolId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Int
ipv4NetmaskLength
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
ipv6CidrBlock
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
ipv6CidrBlockNetworkBorderGroup
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
ipv6IpamPoolId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Int
ipv6NetmaskLength
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
ipv6Pool
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [TagSpecification]
tagSpecifications

instance Prelude.NFData CreateVpc where
  rnf :: CreateVpc -> ()
rnf CreateVpc' {Maybe Bool
Maybe Int
Maybe [TagSpecification]
Maybe Text
Maybe Tenancy
tagSpecifications :: Maybe [TagSpecification]
ipv6Pool :: Maybe Text
ipv6NetmaskLength :: Maybe Int
ipv6IpamPoolId :: Maybe Text
ipv6CidrBlockNetworkBorderGroup :: Maybe Text
ipv6CidrBlock :: Maybe Text
ipv4NetmaskLength :: Maybe Int
ipv4IpamPoolId :: Maybe Text
instanceTenancy :: Maybe Tenancy
dryRun :: Maybe Bool
cidrBlock :: Maybe Text
amazonProvidedIpv6CidrBlock :: Maybe Bool
$sel:tagSpecifications:CreateVpc' :: CreateVpc -> Maybe [TagSpecification]
$sel:ipv6Pool:CreateVpc' :: CreateVpc -> Maybe Text
$sel:ipv6NetmaskLength:CreateVpc' :: CreateVpc -> Maybe Int
$sel:ipv6IpamPoolId:CreateVpc' :: CreateVpc -> Maybe Text
$sel:ipv6CidrBlockNetworkBorderGroup:CreateVpc' :: CreateVpc -> Maybe Text
$sel:ipv6CidrBlock:CreateVpc' :: CreateVpc -> Maybe Text
$sel:ipv4NetmaskLength:CreateVpc' :: CreateVpc -> Maybe Int
$sel:ipv4IpamPoolId:CreateVpc' :: CreateVpc -> Maybe Text
$sel:instanceTenancy:CreateVpc' :: CreateVpc -> Maybe Tenancy
$sel:dryRun:CreateVpc' :: CreateVpc -> Maybe Bool
$sel:cidrBlock:CreateVpc' :: CreateVpc -> Maybe Text
$sel:amazonProvidedIpv6CidrBlock:CreateVpc' :: CreateVpc -> Maybe Bool
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Bool
amazonProvidedIpv6CidrBlock
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
cidrBlock
      seq :: forall a b. a -> b -> b
`Prelude.seq` 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 Tenancy
instanceTenancy
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
ipv4IpamPoolId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Int
ipv4NetmaskLength
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
ipv6CidrBlock
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
ipv6CidrBlockNetworkBorderGroup
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
ipv6IpamPoolId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Int
ipv6NetmaskLength
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
ipv6Pool
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [TagSpecification]
tagSpecifications

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

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

instance Data.ToQuery CreateVpc where
  toQuery :: CreateVpc -> QueryString
toQuery CreateVpc' {Maybe Bool
Maybe Int
Maybe [TagSpecification]
Maybe Text
Maybe Tenancy
tagSpecifications :: Maybe [TagSpecification]
ipv6Pool :: Maybe Text
ipv6NetmaskLength :: Maybe Int
ipv6IpamPoolId :: Maybe Text
ipv6CidrBlockNetworkBorderGroup :: Maybe Text
ipv6CidrBlock :: Maybe Text
ipv4NetmaskLength :: Maybe Int
ipv4IpamPoolId :: Maybe Text
instanceTenancy :: Maybe Tenancy
dryRun :: Maybe Bool
cidrBlock :: Maybe Text
amazonProvidedIpv6CidrBlock :: Maybe Bool
$sel:tagSpecifications:CreateVpc' :: CreateVpc -> Maybe [TagSpecification]
$sel:ipv6Pool:CreateVpc' :: CreateVpc -> Maybe Text
$sel:ipv6NetmaskLength:CreateVpc' :: CreateVpc -> Maybe Int
$sel:ipv6IpamPoolId:CreateVpc' :: CreateVpc -> Maybe Text
$sel:ipv6CidrBlockNetworkBorderGroup:CreateVpc' :: CreateVpc -> Maybe Text
$sel:ipv6CidrBlock:CreateVpc' :: CreateVpc -> Maybe Text
$sel:ipv4NetmaskLength:CreateVpc' :: CreateVpc -> Maybe Int
$sel:ipv4IpamPoolId:CreateVpc' :: CreateVpc -> Maybe Text
$sel:instanceTenancy:CreateVpc' :: CreateVpc -> Maybe Tenancy
$sel:dryRun:CreateVpc' :: CreateVpc -> Maybe Bool
$sel:cidrBlock:CreateVpc' :: CreateVpc -> Maybe Text
$sel:amazonProvidedIpv6CidrBlock:CreateVpc' :: CreateVpc -> Maybe Bool
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"Action"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: (ByteString
"CreateVpc" :: Prelude.ByteString),
        ByteString
"Version"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: (ByteString
"2016-11-15" :: Prelude.ByteString),
        ByteString
"AmazonProvidedIpv6CidrBlock"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Bool
amazonProvidedIpv6CidrBlock,
        ByteString
"CidrBlock" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Text
cidrBlock,
        ByteString
"DryRun" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Bool
dryRun,
        ByteString
"InstanceTenancy" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Tenancy
instanceTenancy,
        ByteString
"Ipv4IpamPoolId" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Text
ipv4IpamPoolId,
        ByteString
"Ipv4NetmaskLength" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Int
ipv4NetmaskLength,
        ByteString
"Ipv6CidrBlock" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Text
ipv6CidrBlock,
        ByteString
"Ipv6CidrBlockNetworkBorderGroup"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Text
ipv6CidrBlockNetworkBorderGroup,
        ByteString
"Ipv6IpamPoolId" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Text
ipv6IpamPoolId,
        ByteString
"Ipv6NetmaskLength" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Int
ipv6NetmaskLength,
        ByteString
"Ipv6Pool" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Text
ipv6Pool,
        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
          )
      ]

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

-- |
-- Create a value of 'CreateVpcResponse' 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:
--
-- 'vpc', 'createVpcResponse_vpc' - Information about the VPC.
--
-- 'httpStatus', 'createVpcResponse_httpStatus' - The response's http status code.
newCreateVpcResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  CreateVpcResponse
newCreateVpcResponse :: Int -> CreateVpcResponse
newCreateVpcResponse Int
pHttpStatus_ =
  CreateVpcResponse'
    { $sel:vpc:CreateVpcResponse' :: Maybe Vpc
vpc = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:CreateVpcResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | Information about the VPC.
createVpcResponse_vpc :: Lens.Lens' CreateVpcResponse (Prelude.Maybe Vpc)
createVpcResponse_vpc :: Lens' CreateVpcResponse (Maybe Vpc)
createVpcResponse_vpc = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateVpcResponse' {Maybe Vpc
vpc :: Maybe Vpc
$sel:vpc:CreateVpcResponse' :: CreateVpcResponse -> Maybe Vpc
vpc} -> Maybe Vpc
vpc) (\s :: CreateVpcResponse
s@CreateVpcResponse' {} Maybe Vpc
a -> CreateVpcResponse
s {$sel:vpc:CreateVpcResponse' :: Maybe Vpc
vpc = Maybe Vpc
a} :: CreateVpcResponse)

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

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