{-# 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.CreateSubnet
-- 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 subnet in a specified VPC.
--
-- You must specify an IPv4 CIDR block for the subnet. After you create a
-- subnet, you can\'t change its CIDR block. The allowed block size is
-- between a \/16 netmask (65,536 IP addresses) and \/28 netmask (16 IP
-- addresses). The CIDR block must not overlap with the CIDR block of an
-- existing subnet in the VPC.
--
-- If you\'ve associated an IPv6 CIDR block with your VPC, you can create a
-- subnet with an IPv6 CIDR block that uses a \/64 prefix length.
--
-- Amazon Web Services reserves both the first four and the last IPv4
-- address in each subnet\'s CIDR block. They\'re not available for use.
--
-- If you add more than one subnet to a VPC, they\'re set up in a star
-- topology with a logical router in the middle.
--
-- When you stop an instance in a subnet, it retains its private IPv4
-- address. It\'s therefore possible to have a subnet with no running
-- instances (they\'re all stopped), but no remaining IP addresses
-- available.
--
-- For more information about subnets, see
-- <https://docs.aws.amazon.com/vpc/latest/userguide/VPC_Subnets.html Your VPC and subnets>
-- in the /Amazon Virtual Private Cloud User Guide/.
module Amazonka.EC2.CreateSubnet
  ( -- * Creating a Request
    CreateSubnet (..),
    newCreateSubnet,

    -- * Request Lenses
    createSubnet_availabilityZone,
    createSubnet_availabilityZoneId,
    createSubnet_cidrBlock,
    createSubnet_dryRun,
    createSubnet_ipv6CidrBlock,
    createSubnet_ipv6Native,
    createSubnet_outpostArn,
    createSubnet_tagSpecifications,
    createSubnet_vpcId,

    -- * Destructuring the Response
    CreateSubnetResponse (..),
    newCreateSubnetResponse,

    -- * Response Lenses
    createSubnetResponse_subnet,
    createSubnetResponse_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:/ 'newCreateSubnet' smart constructor.
data CreateSubnet = CreateSubnet'
  { -- | The Availability Zone or Local Zone for the subnet.
    --
    -- Default: Amazon Web Services selects one for you. If you create more
    -- than one subnet in your VPC, we do not necessarily select a different
    -- zone for each subnet.
    --
    -- To create a subnet in a Local Zone, set this value to the Local Zone ID,
    -- for example @us-west-2-lax-1a@. For information about the Regions that
    -- support Local Zones, see
    -- <https://docs.aws.amazon.com/AWSEC2/latest/UserGuide/using-regions-availability-zones.html#concepts-available-regions Available Regions>
    -- in the /Amazon Elastic Compute Cloud User Guide/.
    --
    -- To create a subnet in an Outpost, set this value to the Availability
    -- Zone for the Outpost and specify the Outpost ARN.
    CreateSubnet -> Maybe Text
availabilityZone :: Prelude.Maybe Prelude.Text,
    -- | The AZ ID or the Local Zone ID of the subnet.
    CreateSubnet -> Maybe Text
availabilityZoneId :: Prelude.Maybe Prelude.Text,
    -- | The IPv4 network range for the subnet, in CIDR notation. For example,
    -- @10.0.0.0\/24@. 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@.
    --
    -- This parameter is not supported for an IPv6 only subnet.
    CreateSubnet -> 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@.
    CreateSubnet -> Maybe Bool
dryRun :: Prelude.Maybe Prelude.Bool,
    -- | The IPv6 network range for the subnet, in CIDR notation. The subnet size
    -- must use a \/64 prefix length.
    --
    -- This parameter is required for an IPv6 only subnet.
    CreateSubnet -> Maybe Text
ipv6CidrBlock :: Prelude.Maybe Prelude.Text,
    -- | Indicates whether to create an IPv6 only subnet.
    CreateSubnet -> Maybe Bool
ipv6Native :: Prelude.Maybe Prelude.Bool,
    -- | The Amazon Resource Name (ARN) of the Outpost. If you specify an Outpost
    -- ARN, you must also specify the Availability Zone of the Outpost subnet.
    CreateSubnet -> Maybe Text
outpostArn :: Prelude.Maybe Prelude.Text,
    -- | The tags to assign to the subnet.
    CreateSubnet -> Maybe [TagSpecification]
tagSpecifications :: Prelude.Maybe [TagSpecification],
    -- | The ID of the VPC.
    CreateSubnet -> Text
vpcId :: Prelude.Text
  }
  deriving (CreateSubnet -> CreateSubnet -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateSubnet -> CreateSubnet -> Bool
$c/= :: CreateSubnet -> CreateSubnet -> Bool
== :: CreateSubnet -> CreateSubnet -> Bool
$c== :: CreateSubnet -> CreateSubnet -> Bool
Prelude.Eq, ReadPrec [CreateSubnet]
ReadPrec CreateSubnet
Int -> ReadS CreateSubnet
ReadS [CreateSubnet]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CreateSubnet]
$creadListPrec :: ReadPrec [CreateSubnet]
readPrec :: ReadPrec CreateSubnet
$creadPrec :: ReadPrec CreateSubnet
readList :: ReadS [CreateSubnet]
$creadList :: ReadS [CreateSubnet]
readsPrec :: Int -> ReadS CreateSubnet
$creadsPrec :: Int -> ReadS CreateSubnet
Prelude.Read, Int -> CreateSubnet -> ShowS
[CreateSubnet] -> ShowS
CreateSubnet -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateSubnet] -> ShowS
$cshowList :: [CreateSubnet] -> ShowS
show :: CreateSubnet -> String
$cshow :: CreateSubnet -> String
showsPrec :: Int -> CreateSubnet -> ShowS
$cshowsPrec :: Int -> CreateSubnet -> ShowS
Prelude.Show, forall x. Rep CreateSubnet x -> CreateSubnet
forall x. CreateSubnet -> Rep CreateSubnet x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CreateSubnet x -> CreateSubnet
$cfrom :: forall x. CreateSubnet -> Rep CreateSubnet x
Prelude.Generic)

-- |
-- Create a value of 'CreateSubnet' 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:
--
-- 'availabilityZone', 'createSubnet_availabilityZone' - The Availability Zone or Local Zone for the subnet.
--
-- Default: Amazon Web Services selects one for you. If you create more
-- than one subnet in your VPC, we do not necessarily select a different
-- zone for each subnet.
--
-- To create a subnet in a Local Zone, set this value to the Local Zone ID,
-- for example @us-west-2-lax-1a@. For information about the Regions that
-- support Local Zones, see
-- <https://docs.aws.amazon.com/AWSEC2/latest/UserGuide/using-regions-availability-zones.html#concepts-available-regions Available Regions>
-- in the /Amazon Elastic Compute Cloud User Guide/.
--
-- To create a subnet in an Outpost, set this value to the Availability
-- Zone for the Outpost and specify the Outpost ARN.
--
-- 'availabilityZoneId', 'createSubnet_availabilityZoneId' - The AZ ID or the Local Zone ID of the subnet.
--
-- 'cidrBlock', 'createSubnet_cidrBlock' - The IPv4 network range for the subnet, in CIDR notation. For example,
-- @10.0.0.0\/24@. 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@.
--
-- This parameter is not supported for an IPv6 only subnet.
--
-- 'dryRun', 'createSubnet_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@.
--
-- 'ipv6CidrBlock', 'createSubnet_ipv6CidrBlock' - The IPv6 network range for the subnet, in CIDR notation. The subnet size
-- must use a \/64 prefix length.
--
-- This parameter is required for an IPv6 only subnet.
--
-- 'ipv6Native', 'createSubnet_ipv6Native' - Indicates whether to create an IPv6 only subnet.
--
-- 'outpostArn', 'createSubnet_outpostArn' - The Amazon Resource Name (ARN) of the Outpost. If you specify an Outpost
-- ARN, you must also specify the Availability Zone of the Outpost subnet.
--
-- 'tagSpecifications', 'createSubnet_tagSpecifications' - The tags to assign to the subnet.
--
-- 'vpcId', 'createSubnet_vpcId' - The ID of the VPC.
newCreateSubnet ::
  -- | 'vpcId'
  Prelude.Text ->
  CreateSubnet
newCreateSubnet :: Text -> CreateSubnet
newCreateSubnet Text
pVpcId_ =
  CreateSubnet'
    { $sel:availabilityZone:CreateSubnet' :: Maybe Text
availabilityZone = forall a. Maybe a
Prelude.Nothing,
      $sel:availabilityZoneId:CreateSubnet' :: Maybe Text
availabilityZoneId = forall a. Maybe a
Prelude.Nothing,
      $sel:cidrBlock:CreateSubnet' :: Maybe Text
cidrBlock = forall a. Maybe a
Prelude.Nothing,
      $sel:dryRun:CreateSubnet' :: Maybe Bool
dryRun = forall a. Maybe a
Prelude.Nothing,
      $sel:ipv6CidrBlock:CreateSubnet' :: Maybe Text
ipv6CidrBlock = forall a. Maybe a
Prelude.Nothing,
      $sel:ipv6Native:CreateSubnet' :: Maybe Bool
ipv6Native = forall a. Maybe a
Prelude.Nothing,
      $sel:outpostArn:CreateSubnet' :: Maybe Text
outpostArn = forall a. Maybe a
Prelude.Nothing,
      $sel:tagSpecifications:CreateSubnet' :: Maybe [TagSpecification]
tagSpecifications = forall a. Maybe a
Prelude.Nothing,
      $sel:vpcId:CreateSubnet' :: Text
vpcId = Text
pVpcId_
    }

-- | The Availability Zone or Local Zone for the subnet.
--
-- Default: Amazon Web Services selects one for you. If you create more
-- than one subnet in your VPC, we do not necessarily select a different
-- zone for each subnet.
--
-- To create a subnet in a Local Zone, set this value to the Local Zone ID,
-- for example @us-west-2-lax-1a@. For information about the Regions that
-- support Local Zones, see
-- <https://docs.aws.amazon.com/AWSEC2/latest/UserGuide/using-regions-availability-zones.html#concepts-available-regions Available Regions>
-- in the /Amazon Elastic Compute Cloud User Guide/.
--
-- To create a subnet in an Outpost, set this value to the Availability
-- Zone for the Outpost and specify the Outpost ARN.
createSubnet_availabilityZone :: Lens.Lens' CreateSubnet (Prelude.Maybe Prelude.Text)
createSubnet_availabilityZone :: Lens' CreateSubnet (Maybe Text)
createSubnet_availabilityZone = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateSubnet' {Maybe Text
availabilityZone :: Maybe Text
$sel:availabilityZone:CreateSubnet' :: CreateSubnet -> Maybe Text
availabilityZone} -> Maybe Text
availabilityZone) (\s :: CreateSubnet
s@CreateSubnet' {} Maybe Text
a -> CreateSubnet
s {$sel:availabilityZone:CreateSubnet' :: Maybe Text
availabilityZone = Maybe Text
a} :: CreateSubnet)

-- | The AZ ID or the Local Zone ID of the subnet.
createSubnet_availabilityZoneId :: Lens.Lens' CreateSubnet (Prelude.Maybe Prelude.Text)
createSubnet_availabilityZoneId :: Lens' CreateSubnet (Maybe Text)
createSubnet_availabilityZoneId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateSubnet' {Maybe Text
availabilityZoneId :: Maybe Text
$sel:availabilityZoneId:CreateSubnet' :: CreateSubnet -> Maybe Text
availabilityZoneId} -> Maybe Text
availabilityZoneId) (\s :: CreateSubnet
s@CreateSubnet' {} Maybe Text
a -> CreateSubnet
s {$sel:availabilityZoneId:CreateSubnet' :: Maybe Text
availabilityZoneId = Maybe Text
a} :: CreateSubnet)

-- | The IPv4 network range for the subnet, in CIDR notation. For example,
-- @10.0.0.0\/24@. 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@.
--
-- This parameter is not supported for an IPv6 only subnet.
createSubnet_cidrBlock :: Lens.Lens' CreateSubnet (Prelude.Maybe Prelude.Text)
createSubnet_cidrBlock :: Lens' CreateSubnet (Maybe Text)
createSubnet_cidrBlock = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateSubnet' {Maybe Text
cidrBlock :: Maybe Text
$sel:cidrBlock:CreateSubnet' :: CreateSubnet -> Maybe Text
cidrBlock} -> Maybe Text
cidrBlock) (\s :: CreateSubnet
s@CreateSubnet' {} Maybe Text
a -> CreateSubnet
s {$sel:cidrBlock:CreateSubnet' :: Maybe Text
cidrBlock = Maybe Text
a} :: CreateSubnet)

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

-- | The IPv6 network range for the subnet, in CIDR notation. The subnet size
-- must use a \/64 prefix length.
--
-- This parameter is required for an IPv6 only subnet.
createSubnet_ipv6CidrBlock :: Lens.Lens' CreateSubnet (Prelude.Maybe Prelude.Text)
createSubnet_ipv6CidrBlock :: Lens' CreateSubnet (Maybe Text)
createSubnet_ipv6CidrBlock = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateSubnet' {Maybe Text
ipv6CidrBlock :: Maybe Text
$sel:ipv6CidrBlock:CreateSubnet' :: CreateSubnet -> Maybe Text
ipv6CidrBlock} -> Maybe Text
ipv6CidrBlock) (\s :: CreateSubnet
s@CreateSubnet' {} Maybe Text
a -> CreateSubnet
s {$sel:ipv6CidrBlock:CreateSubnet' :: Maybe Text
ipv6CidrBlock = Maybe Text
a} :: CreateSubnet)

-- | Indicates whether to create an IPv6 only subnet.
createSubnet_ipv6Native :: Lens.Lens' CreateSubnet (Prelude.Maybe Prelude.Bool)
createSubnet_ipv6Native :: Lens' CreateSubnet (Maybe Bool)
createSubnet_ipv6Native = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateSubnet' {Maybe Bool
ipv6Native :: Maybe Bool
$sel:ipv6Native:CreateSubnet' :: CreateSubnet -> Maybe Bool
ipv6Native} -> Maybe Bool
ipv6Native) (\s :: CreateSubnet
s@CreateSubnet' {} Maybe Bool
a -> CreateSubnet
s {$sel:ipv6Native:CreateSubnet' :: Maybe Bool
ipv6Native = Maybe Bool
a} :: CreateSubnet)

-- | The Amazon Resource Name (ARN) of the Outpost. If you specify an Outpost
-- ARN, you must also specify the Availability Zone of the Outpost subnet.
createSubnet_outpostArn :: Lens.Lens' CreateSubnet (Prelude.Maybe Prelude.Text)
createSubnet_outpostArn :: Lens' CreateSubnet (Maybe Text)
createSubnet_outpostArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateSubnet' {Maybe Text
outpostArn :: Maybe Text
$sel:outpostArn:CreateSubnet' :: CreateSubnet -> Maybe Text
outpostArn} -> Maybe Text
outpostArn) (\s :: CreateSubnet
s@CreateSubnet' {} Maybe Text
a -> CreateSubnet
s {$sel:outpostArn:CreateSubnet' :: Maybe Text
outpostArn = Maybe Text
a} :: CreateSubnet)

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

instance Core.AWSRequest CreateSubnet where
  type AWSResponse CreateSubnet = CreateSubnetResponse
  request :: (Service -> Service) -> CreateSubnet -> Request CreateSubnet
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 CreateSubnet
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse CreateSubnet)))
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 Subnet -> Int -> CreateSubnetResponse
CreateSubnetResponse'
            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
"subnet")
            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 CreateSubnet where
  hashWithSalt :: Int -> CreateSubnet -> Int
hashWithSalt Int
_salt CreateSubnet' {Maybe Bool
Maybe [TagSpecification]
Maybe Text
Text
vpcId :: Text
tagSpecifications :: Maybe [TagSpecification]
outpostArn :: Maybe Text
ipv6Native :: Maybe Bool
ipv6CidrBlock :: Maybe Text
dryRun :: Maybe Bool
cidrBlock :: Maybe Text
availabilityZoneId :: Maybe Text
availabilityZone :: Maybe Text
$sel:vpcId:CreateSubnet' :: CreateSubnet -> Text
$sel:tagSpecifications:CreateSubnet' :: CreateSubnet -> Maybe [TagSpecification]
$sel:outpostArn:CreateSubnet' :: CreateSubnet -> Maybe Text
$sel:ipv6Native:CreateSubnet' :: CreateSubnet -> Maybe Bool
$sel:ipv6CidrBlock:CreateSubnet' :: CreateSubnet -> Maybe Text
$sel:dryRun:CreateSubnet' :: CreateSubnet -> Maybe Bool
$sel:cidrBlock:CreateSubnet' :: CreateSubnet -> Maybe Text
$sel:availabilityZoneId:CreateSubnet' :: CreateSubnet -> Maybe Text
$sel:availabilityZone:CreateSubnet' :: CreateSubnet -> Maybe Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
availabilityZone
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
availabilityZoneId
      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 Text
ipv6CidrBlock
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Bool
ipv6Native
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
outpostArn
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [TagSpecification]
tagSpecifications
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
vpcId

instance Prelude.NFData CreateSubnet where
  rnf :: CreateSubnet -> ()
rnf CreateSubnet' {Maybe Bool
Maybe [TagSpecification]
Maybe Text
Text
vpcId :: Text
tagSpecifications :: Maybe [TagSpecification]
outpostArn :: Maybe Text
ipv6Native :: Maybe Bool
ipv6CidrBlock :: Maybe Text
dryRun :: Maybe Bool
cidrBlock :: Maybe Text
availabilityZoneId :: Maybe Text
availabilityZone :: Maybe Text
$sel:vpcId:CreateSubnet' :: CreateSubnet -> Text
$sel:tagSpecifications:CreateSubnet' :: CreateSubnet -> Maybe [TagSpecification]
$sel:outpostArn:CreateSubnet' :: CreateSubnet -> Maybe Text
$sel:ipv6Native:CreateSubnet' :: CreateSubnet -> Maybe Bool
$sel:ipv6CidrBlock:CreateSubnet' :: CreateSubnet -> Maybe Text
$sel:dryRun:CreateSubnet' :: CreateSubnet -> Maybe Bool
$sel:cidrBlock:CreateSubnet' :: CreateSubnet -> Maybe Text
$sel:availabilityZoneId:CreateSubnet' :: CreateSubnet -> Maybe Text
$sel:availabilityZone:CreateSubnet' :: CreateSubnet -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
availabilityZone
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
availabilityZoneId
      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 Text
ipv6CidrBlock
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Bool
ipv6Native
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
outpostArn
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [TagSpecification]
tagSpecifications
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
vpcId

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

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

instance Data.ToQuery CreateSubnet where
  toQuery :: CreateSubnet -> QueryString
toQuery CreateSubnet' {Maybe Bool
Maybe [TagSpecification]
Maybe Text
Text
vpcId :: Text
tagSpecifications :: Maybe [TagSpecification]
outpostArn :: Maybe Text
ipv6Native :: Maybe Bool
ipv6CidrBlock :: Maybe Text
dryRun :: Maybe Bool
cidrBlock :: Maybe Text
availabilityZoneId :: Maybe Text
availabilityZone :: Maybe Text
$sel:vpcId:CreateSubnet' :: CreateSubnet -> Text
$sel:tagSpecifications:CreateSubnet' :: CreateSubnet -> Maybe [TagSpecification]
$sel:outpostArn:CreateSubnet' :: CreateSubnet -> Maybe Text
$sel:ipv6Native:CreateSubnet' :: CreateSubnet -> Maybe Bool
$sel:ipv6CidrBlock:CreateSubnet' :: CreateSubnet -> Maybe Text
$sel:dryRun:CreateSubnet' :: CreateSubnet -> Maybe Bool
$sel:cidrBlock:CreateSubnet' :: CreateSubnet -> Maybe Text
$sel:availabilityZoneId:CreateSubnet' :: CreateSubnet -> Maybe Text
$sel:availabilityZone:CreateSubnet' :: CreateSubnet -> Maybe Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"Action"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: (ByteString
"CreateSubnet" :: Prelude.ByteString),
        ByteString
"Version"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: (ByteString
"2016-11-15" :: Prelude.ByteString),
        ByteString
"AvailabilityZone" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Text
availabilityZone,
        ByteString
"AvailabilityZoneId" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Text
availabilityZoneId,
        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
"Ipv6CidrBlock" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Text
ipv6CidrBlock,
        ByteString
"Ipv6Native" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Bool
ipv6Native,
        ByteString
"OutpostArn" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Text
outpostArn,
        forall a. ToQuery a => a -> QueryString
Data.toQuery
          ( forall a.
(IsList a, ToQuery (Item a)) =>
ByteString -> a -> QueryString
Data.toQueryList ByteString
"TagSpecification"
              forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe [TagSpecification]
tagSpecifications
          ),
        ByteString
"VpcId" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Text
vpcId
      ]

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

-- |
-- Create a value of 'CreateSubnetResponse' 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:
--
-- 'subnet', 'createSubnetResponse_subnet' - Information about the subnet.
--
-- 'httpStatus', 'createSubnetResponse_httpStatus' - The response's http status code.
newCreateSubnetResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  CreateSubnetResponse
newCreateSubnetResponse :: Int -> CreateSubnetResponse
newCreateSubnetResponse Int
pHttpStatus_ =
  CreateSubnetResponse'
    { $sel:subnet:CreateSubnetResponse' :: Maybe Subnet
subnet = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:CreateSubnetResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | Information about the subnet.
createSubnetResponse_subnet :: Lens.Lens' CreateSubnetResponse (Prelude.Maybe Subnet)
createSubnetResponse_subnet :: Lens' CreateSubnetResponse (Maybe Subnet)
createSubnetResponse_subnet = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateSubnetResponse' {Maybe Subnet
subnet :: Maybe Subnet
$sel:subnet:CreateSubnetResponse' :: CreateSubnetResponse -> Maybe Subnet
subnet} -> Maybe Subnet
subnet) (\s :: CreateSubnetResponse
s@CreateSubnetResponse' {} Maybe Subnet
a -> CreateSubnetResponse
s {$sel:subnet:CreateSubnetResponse' :: Maybe Subnet
subnet = Maybe Subnet
a} :: CreateSubnetResponse)

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

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