{-# 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.CreateNatGateway
-- 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 NAT gateway in the specified subnet. This action creates a
-- network interface in the specified subnet with a private IP address from
-- the IP address range of the subnet. You can create either a public NAT
-- gateway or a private NAT gateway.
--
-- With a public NAT gateway, internet-bound traffic from a private subnet
-- can be routed to the NAT gateway, so that instances in a private subnet
-- can connect to the internet.
--
-- With a private NAT gateway, private communication is routed across VPCs
-- and on-premises networks through a transit gateway or virtual private
-- gateway. Common use cases include running large workloads behind a small
-- pool of allowlisted IPv4 addresses, preserving private IPv4 addresses,
-- and communicating between overlapping networks.
--
-- For more information, see
-- <https://docs.aws.amazon.com/vpc/latest/userguide/vpc-nat-gateway.html NAT gateways>
-- in the /Amazon Virtual Private Cloud User Guide/.
module Amazonka.EC2.CreateNatGateway
  ( -- * Creating a Request
    CreateNatGateway (..),
    newCreateNatGateway,

    -- * Request Lenses
    createNatGateway_allocationId,
    createNatGateway_clientToken,
    createNatGateway_connectivityType,
    createNatGateway_dryRun,
    createNatGateway_privateIpAddress,
    createNatGateway_tagSpecifications,
    createNatGateway_subnetId,

    -- * Destructuring the Response
    CreateNatGatewayResponse (..),
    newCreateNatGatewayResponse,

    -- * Response Lenses
    createNatGatewayResponse_clientToken,
    createNatGatewayResponse_natGateway,
    createNatGatewayResponse_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:/ 'newCreateNatGateway' smart constructor.
data CreateNatGateway = CreateNatGateway'
  { -- | [Public NAT gateways only] The allocation ID of an Elastic IP address to
    -- associate with the NAT gateway. You cannot specify an Elastic IP address
    -- with a private NAT gateway. If the Elastic IP address is associated with
    -- another resource, you must first disassociate it.
    CreateNatGateway -> Maybe Text
allocationId :: Prelude.Maybe Prelude.Text,
    -- | Unique, case-sensitive identifier that you provide to ensure the
    -- idempotency of the request. For more information, see
    -- <https://docs.aws.amazon.com/AWSEC2/latest/APIReference/Run_Instance_Idempotency.html How to ensure idempotency>.
    --
    -- Constraint: Maximum 64 ASCII characters.
    CreateNatGateway -> Maybe Text
clientToken :: Prelude.Maybe Prelude.Text,
    -- | Indicates whether the NAT gateway supports public or private
    -- connectivity. The default is public connectivity.
    CreateNatGateway -> Maybe ConnectivityType
connectivityType :: Prelude.Maybe ConnectivityType,
    -- | 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@.
    CreateNatGateway -> Maybe Bool
dryRun :: Prelude.Maybe Prelude.Bool,
    -- | The private IPv4 address to assign to the NAT gateway. If you don\'t
    -- provide an address, a private IPv4 address will be automatically
    -- assigned.
    CreateNatGateway -> Maybe Text
privateIpAddress :: Prelude.Maybe Prelude.Text,
    -- | The tags to assign to the NAT gateway.
    CreateNatGateway -> Maybe [TagSpecification]
tagSpecifications :: Prelude.Maybe [TagSpecification],
    -- | The subnet in which to create the NAT gateway.
    CreateNatGateway -> Text
subnetId :: Prelude.Text
  }
  deriving (CreateNatGateway -> CreateNatGateway -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateNatGateway -> CreateNatGateway -> Bool
$c/= :: CreateNatGateway -> CreateNatGateway -> Bool
== :: CreateNatGateway -> CreateNatGateway -> Bool
$c== :: CreateNatGateway -> CreateNatGateway -> Bool
Prelude.Eq, ReadPrec [CreateNatGateway]
ReadPrec CreateNatGateway
Int -> ReadS CreateNatGateway
ReadS [CreateNatGateway]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CreateNatGateway]
$creadListPrec :: ReadPrec [CreateNatGateway]
readPrec :: ReadPrec CreateNatGateway
$creadPrec :: ReadPrec CreateNatGateway
readList :: ReadS [CreateNatGateway]
$creadList :: ReadS [CreateNatGateway]
readsPrec :: Int -> ReadS CreateNatGateway
$creadsPrec :: Int -> ReadS CreateNatGateway
Prelude.Read, Int -> CreateNatGateway -> ShowS
[CreateNatGateway] -> ShowS
CreateNatGateway -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateNatGateway] -> ShowS
$cshowList :: [CreateNatGateway] -> ShowS
show :: CreateNatGateway -> String
$cshow :: CreateNatGateway -> String
showsPrec :: Int -> CreateNatGateway -> ShowS
$cshowsPrec :: Int -> CreateNatGateway -> ShowS
Prelude.Show, forall x. Rep CreateNatGateway x -> CreateNatGateway
forall x. CreateNatGateway -> Rep CreateNatGateway x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CreateNatGateway x -> CreateNatGateway
$cfrom :: forall x. CreateNatGateway -> Rep CreateNatGateway x
Prelude.Generic)

-- |
-- Create a value of 'CreateNatGateway' 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:
--
-- 'allocationId', 'createNatGateway_allocationId' - [Public NAT gateways only] The allocation ID of an Elastic IP address to
-- associate with the NAT gateway. You cannot specify an Elastic IP address
-- with a private NAT gateway. If the Elastic IP address is associated with
-- another resource, you must first disassociate it.
--
-- 'clientToken', 'createNatGateway_clientToken' - Unique, case-sensitive identifier that you provide to ensure the
-- idempotency of the request. For more information, see
-- <https://docs.aws.amazon.com/AWSEC2/latest/APIReference/Run_Instance_Idempotency.html How to ensure idempotency>.
--
-- Constraint: Maximum 64 ASCII characters.
--
-- 'connectivityType', 'createNatGateway_connectivityType' - Indicates whether the NAT gateway supports public or private
-- connectivity. The default is public connectivity.
--
-- 'dryRun', 'createNatGateway_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@.
--
-- 'privateIpAddress', 'createNatGateway_privateIpAddress' - The private IPv4 address to assign to the NAT gateway. If you don\'t
-- provide an address, a private IPv4 address will be automatically
-- assigned.
--
-- 'tagSpecifications', 'createNatGateway_tagSpecifications' - The tags to assign to the NAT gateway.
--
-- 'subnetId', 'createNatGateway_subnetId' - The subnet in which to create the NAT gateway.
newCreateNatGateway ::
  -- | 'subnetId'
  Prelude.Text ->
  CreateNatGateway
newCreateNatGateway :: Text -> CreateNatGateway
newCreateNatGateway Text
pSubnetId_ =
  CreateNatGateway'
    { $sel:allocationId:CreateNatGateway' :: Maybe Text
allocationId = forall a. Maybe a
Prelude.Nothing,
      $sel:clientToken:CreateNatGateway' :: Maybe Text
clientToken = forall a. Maybe a
Prelude.Nothing,
      $sel:connectivityType:CreateNatGateway' :: Maybe ConnectivityType
connectivityType = forall a. Maybe a
Prelude.Nothing,
      $sel:dryRun:CreateNatGateway' :: Maybe Bool
dryRun = forall a. Maybe a
Prelude.Nothing,
      $sel:privateIpAddress:CreateNatGateway' :: Maybe Text
privateIpAddress = forall a. Maybe a
Prelude.Nothing,
      $sel:tagSpecifications:CreateNatGateway' :: Maybe [TagSpecification]
tagSpecifications = forall a. Maybe a
Prelude.Nothing,
      $sel:subnetId:CreateNatGateway' :: Text
subnetId = Text
pSubnetId_
    }

-- | [Public NAT gateways only] The allocation ID of an Elastic IP address to
-- associate with the NAT gateway. You cannot specify an Elastic IP address
-- with a private NAT gateway. If the Elastic IP address is associated with
-- another resource, you must first disassociate it.
createNatGateway_allocationId :: Lens.Lens' CreateNatGateway (Prelude.Maybe Prelude.Text)
createNatGateway_allocationId :: Lens' CreateNatGateway (Maybe Text)
createNatGateway_allocationId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateNatGateway' {Maybe Text
allocationId :: Maybe Text
$sel:allocationId:CreateNatGateway' :: CreateNatGateway -> Maybe Text
allocationId} -> Maybe Text
allocationId) (\s :: CreateNatGateway
s@CreateNatGateway' {} Maybe Text
a -> CreateNatGateway
s {$sel:allocationId:CreateNatGateway' :: Maybe Text
allocationId = Maybe Text
a} :: CreateNatGateway)

-- | Unique, case-sensitive identifier that you provide to ensure the
-- idempotency of the request. For more information, see
-- <https://docs.aws.amazon.com/AWSEC2/latest/APIReference/Run_Instance_Idempotency.html How to ensure idempotency>.
--
-- Constraint: Maximum 64 ASCII characters.
createNatGateway_clientToken :: Lens.Lens' CreateNatGateway (Prelude.Maybe Prelude.Text)
createNatGateway_clientToken :: Lens' CreateNatGateway (Maybe Text)
createNatGateway_clientToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateNatGateway' {Maybe Text
clientToken :: Maybe Text
$sel:clientToken:CreateNatGateway' :: CreateNatGateway -> Maybe Text
clientToken} -> Maybe Text
clientToken) (\s :: CreateNatGateway
s@CreateNatGateway' {} Maybe Text
a -> CreateNatGateway
s {$sel:clientToken:CreateNatGateway' :: Maybe Text
clientToken = Maybe Text
a} :: CreateNatGateway)

-- | Indicates whether the NAT gateway supports public or private
-- connectivity. The default is public connectivity.
createNatGateway_connectivityType :: Lens.Lens' CreateNatGateway (Prelude.Maybe ConnectivityType)
createNatGateway_connectivityType :: Lens' CreateNatGateway (Maybe ConnectivityType)
createNatGateway_connectivityType = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateNatGateway' {Maybe ConnectivityType
connectivityType :: Maybe ConnectivityType
$sel:connectivityType:CreateNatGateway' :: CreateNatGateway -> Maybe ConnectivityType
connectivityType} -> Maybe ConnectivityType
connectivityType) (\s :: CreateNatGateway
s@CreateNatGateway' {} Maybe ConnectivityType
a -> CreateNatGateway
s {$sel:connectivityType:CreateNatGateway' :: Maybe ConnectivityType
connectivityType = Maybe ConnectivityType
a} :: CreateNatGateway)

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

-- | The private IPv4 address to assign to the NAT gateway. If you don\'t
-- provide an address, a private IPv4 address will be automatically
-- assigned.
createNatGateway_privateIpAddress :: Lens.Lens' CreateNatGateway (Prelude.Maybe Prelude.Text)
createNatGateway_privateIpAddress :: Lens' CreateNatGateway (Maybe Text)
createNatGateway_privateIpAddress = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateNatGateway' {Maybe Text
privateIpAddress :: Maybe Text
$sel:privateIpAddress:CreateNatGateway' :: CreateNatGateway -> Maybe Text
privateIpAddress} -> Maybe Text
privateIpAddress) (\s :: CreateNatGateway
s@CreateNatGateway' {} Maybe Text
a -> CreateNatGateway
s {$sel:privateIpAddress:CreateNatGateway' :: Maybe Text
privateIpAddress = Maybe Text
a} :: CreateNatGateway)

-- | The tags to assign to the NAT gateway.
createNatGateway_tagSpecifications :: Lens.Lens' CreateNatGateway (Prelude.Maybe [TagSpecification])
createNatGateway_tagSpecifications :: Lens' CreateNatGateway (Maybe [TagSpecification])
createNatGateway_tagSpecifications = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateNatGateway' {Maybe [TagSpecification]
tagSpecifications :: Maybe [TagSpecification]
$sel:tagSpecifications:CreateNatGateway' :: CreateNatGateway -> Maybe [TagSpecification]
tagSpecifications} -> Maybe [TagSpecification]
tagSpecifications) (\s :: CreateNatGateway
s@CreateNatGateway' {} Maybe [TagSpecification]
a -> CreateNatGateway
s {$sel:tagSpecifications:CreateNatGateway' :: Maybe [TagSpecification]
tagSpecifications = Maybe [TagSpecification]
a} :: CreateNatGateway) 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 subnet in which to create the NAT gateway.
createNatGateway_subnetId :: Lens.Lens' CreateNatGateway Prelude.Text
createNatGateway_subnetId :: Lens' CreateNatGateway Text
createNatGateway_subnetId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateNatGateway' {Text
subnetId :: Text
$sel:subnetId:CreateNatGateway' :: CreateNatGateway -> Text
subnetId} -> Text
subnetId) (\s :: CreateNatGateway
s@CreateNatGateway' {} Text
a -> CreateNatGateway
s {$sel:subnetId:CreateNatGateway' :: Text
subnetId = Text
a} :: CreateNatGateway)

instance Core.AWSRequest CreateNatGateway where
  type
    AWSResponse CreateNatGateway =
      CreateNatGatewayResponse
  request :: (Service -> Service)
-> CreateNatGateway -> Request CreateNatGateway
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 CreateNatGateway
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse CreateNatGateway)))
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 Text -> Maybe NatGateway -> Int -> CreateNatGatewayResponse
CreateNatGatewayResponse'
            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
"clientToken")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> ([Node]
x forall a. FromXML a => [Node] -> Text -> Either String (Maybe a)
Data..@? Text
"natGateway")
            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 CreateNatGateway where
  hashWithSalt :: Int -> CreateNatGateway -> Int
hashWithSalt Int
_salt CreateNatGateway' {Maybe Bool
Maybe [TagSpecification]
Maybe Text
Maybe ConnectivityType
Text
subnetId :: Text
tagSpecifications :: Maybe [TagSpecification]
privateIpAddress :: Maybe Text
dryRun :: Maybe Bool
connectivityType :: Maybe ConnectivityType
clientToken :: Maybe Text
allocationId :: Maybe Text
$sel:subnetId:CreateNatGateway' :: CreateNatGateway -> Text
$sel:tagSpecifications:CreateNatGateway' :: CreateNatGateway -> Maybe [TagSpecification]
$sel:privateIpAddress:CreateNatGateway' :: CreateNatGateway -> Maybe Text
$sel:dryRun:CreateNatGateway' :: CreateNatGateway -> Maybe Bool
$sel:connectivityType:CreateNatGateway' :: CreateNatGateway -> Maybe ConnectivityType
$sel:clientToken:CreateNatGateway' :: CreateNatGateway -> Maybe Text
$sel:allocationId:CreateNatGateway' :: CreateNatGateway -> Maybe Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
allocationId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
clientToken
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe ConnectivityType
connectivityType
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Bool
dryRun
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
privateIpAddress
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [TagSpecification]
tagSpecifications
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
subnetId

instance Prelude.NFData CreateNatGateway where
  rnf :: CreateNatGateway -> ()
rnf CreateNatGateway' {Maybe Bool
Maybe [TagSpecification]
Maybe Text
Maybe ConnectivityType
Text
subnetId :: Text
tagSpecifications :: Maybe [TagSpecification]
privateIpAddress :: Maybe Text
dryRun :: Maybe Bool
connectivityType :: Maybe ConnectivityType
clientToken :: Maybe Text
allocationId :: Maybe Text
$sel:subnetId:CreateNatGateway' :: CreateNatGateway -> Text
$sel:tagSpecifications:CreateNatGateway' :: CreateNatGateway -> Maybe [TagSpecification]
$sel:privateIpAddress:CreateNatGateway' :: CreateNatGateway -> Maybe Text
$sel:dryRun:CreateNatGateway' :: CreateNatGateway -> Maybe Bool
$sel:connectivityType:CreateNatGateway' :: CreateNatGateway -> Maybe ConnectivityType
$sel:clientToken:CreateNatGateway' :: CreateNatGateway -> Maybe Text
$sel:allocationId:CreateNatGateway' :: CreateNatGateway -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
allocationId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
clientToken
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe ConnectivityType
connectivityType
      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
privateIpAddress
      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
subnetId

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

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

instance Data.ToQuery CreateNatGateway where
  toQuery :: CreateNatGateway -> QueryString
toQuery CreateNatGateway' {Maybe Bool
Maybe [TagSpecification]
Maybe Text
Maybe ConnectivityType
Text
subnetId :: Text
tagSpecifications :: Maybe [TagSpecification]
privateIpAddress :: Maybe Text
dryRun :: Maybe Bool
connectivityType :: Maybe ConnectivityType
clientToken :: Maybe Text
allocationId :: Maybe Text
$sel:subnetId:CreateNatGateway' :: CreateNatGateway -> Text
$sel:tagSpecifications:CreateNatGateway' :: CreateNatGateway -> Maybe [TagSpecification]
$sel:privateIpAddress:CreateNatGateway' :: CreateNatGateway -> Maybe Text
$sel:dryRun:CreateNatGateway' :: CreateNatGateway -> Maybe Bool
$sel:connectivityType:CreateNatGateway' :: CreateNatGateway -> Maybe ConnectivityType
$sel:clientToken:CreateNatGateway' :: CreateNatGateway -> Maybe Text
$sel:allocationId:CreateNatGateway' :: CreateNatGateway -> Maybe Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"Action"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: (ByteString
"CreateNatGateway" :: Prelude.ByteString),
        ByteString
"Version"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: (ByteString
"2016-11-15" :: Prelude.ByteString),
        ByteString
"AllocationId" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Text
allocationId,
        ByteString
"ClientToken" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Text
clientToken,
        ByteString
"ConnectivityType" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe ConnectivityType
connectivityType,
        ByteString
"DryRun" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Bool
dryRun,
        ByteString
"PrivateIpAddress" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Text
privateIpAddress,
        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
"SubnetId" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Text
subnetId
      ]

-- | /See:/ 'newCreateNatGatewayResponse' smart constructor.
data CreateNatGatewayResponse = CreateNatGatewayResponse'
  { -- | Unique, case-sensitive identifier to ensure the idempotency of the
    -- request. Only returned if a client token was provided in the request.
    CreateNatGatewayResponse -> Maybe Text
clientToken :: Prelude.Maybe Prelude.Text,
    -- | Information about the NAT gateway.
    CreateNatGatewayResponse -> Maybe NatGateway
natGateway :: Prelude.Maybe NatGateway,
    -- | The response's http status code.
    CreateNatGatewayResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (CreateNatGatewayResponse -> CreateNatGatewayResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateNatGatewayResponse -> CreateNatGatewayResponse -> Bool
$c/= :: CreateNatGatewayResponse -> CreateNatGatewayResponse -> Bool
== :: CreateNatGatewayResponse -> CreateNatGatewayResponse -> Bool
$c== :: CreateNatGatewayResponse -> CreateNatGatewayResponse -> Bool
Prelude.Eq, ReadPrec [CreateNatGatewayResponse]
ReadPrec CreateNatGatewayResponse
Int -> ReadS CreateNatGatewayResponse
ReadS [CreateNatGatewayResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CreateNatGatewayResponse]
$creadListPrec :: ReadPrec [CreateNatGatewayResponse]
readPrec :: ReadPrec CreateNatGatewayResponse
$creadPrec :: ReadPrec CreateNatGatewayResponse
readList :: ReadS [CreateNatGatewayResponse]
$creadList :: ReadS [CreateNatGatewayResponse]
readsPrec :: Int -> ReadS CreateNatGatewayResponse
$creadsPrec :: Int -> ReadS CreateNatGatewayResponse
Prelude.Read, Int -> CreateNatGatewayResponse -> ShowS
[CreateNatGatewayResponse] -> ShowS
CreateNatGatewayResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateNatGatewayResponse] -> ShowS
$cshowList :: [CreateNatGatewayResponse] -> ShowS
show :: CreateNatGatewayResponse -> String
$cshow :: CreateNatGatewayResponse -> String
showsPrec :: Int -> CreateNatGatewayResponse -> ShowS
$cshowsPrec :: Int -> CreateNatGatewayResponse -> ShowS
Prelude.Show, forall x.
Rep CreateNatGatewayResponse x -> CreateNatGatewayResponse
forall x.
CreateNatGatewayResponse -> Rep CreateNatGatewayResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep CreateNatGatewayResponse x -> CreateNatGatewayResponse
$cfrom :: forall x.
CreateNatGatewayResponse -> Rep CreateNatGatewayResponse x
Prelude.Generic)

-- |
-- Create a value of 'CreateNatGatewayResponse' 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:
--
-- 'clientToken', 'createNatGatewayResponse_clientToken' - Unique, case-sensitive identifier to ensure the idempotency of the
-- request. Only returned if a client token was provided in the request.
--
-- 'natGateway', 'createNatGatewayResponse_natGateway' - Information about the NAT gateway.
--
-- 'httpStatus', 'createNatGatewayResponse_httpStatus' - The response's http status code.
newCreateNatGatewayResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  CreateNatGatewayResponse
newCreateNatGatewayResponse :: Int -> CreateNatGatewayResponse
newCreateNatGatewayResponse Int
pHttpStatus_ =
  CreateNatGatewayResponse'
    { $sel:clientToken:CreateNatGatewayResponse' :: Maybe Text
clientToken =
        forall a. Maybe a
Prelude.Nothing,
      $sel:natGateway:CreateNatGatewayResponse' :: Maybe NatGateway
natGateway = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:CreateNatGatewayResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | Unique, case-sensitive identifier to ensure the idempotency of the
-- request. Only returned if a client token was provided in the request.
createNatGatewayResponse_clientToken :: Lens.Lens' CreateNatGatewayResponse (Prelude.Maybe Prelude.Text)
createNatGatewayResponse_clientToken :: Lens' CreateNatGatewayResponse (Maybe Text)
createNatGatewayResponse_clientToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateNatGatewayResponse' {Maybe Text
clientToken :: Maybe Text
$sel:clientToken:CreateNatGatewayResponse' :: CreateNatGatewayResponse -> Maybe Text
clientToken} -> Maybe Text
clientToken) (\s :: CreateNatGatewayResponse
s@CreateNatGatewayResponse' {} Maybe Text
a -> CreateNatGatewayResponse
s {$sel:clientToken:CreateNatGatewayResponse' :: Maybe Text
clientToken = Maybe Text
a} :: CreateNatGatewayResponse)

-- | Information about the NAT gateway.
createNatGatewayResponse_natGateway :: Lens.Lens' CreateNatGatewayResponse (Prelude.Maybe NatGateway)
createNatGatewayResponse_natGateway :: Lens' CreateNatGatewayResponse (Maybe NatGateway)
createNatGatewayResponse_natGateway = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateNatGatewayResponse' {Maybe NatGateway
natGateway :: Maybe NatGateway
$sel:natGateway:CreateNatGatewayResponse' :: CreateNatGatewayResponse -> Maybe NatGateway
natGateway} -> Maybe NatGateway
natGateway) (\s :: CreateNatGatewayResponse
s@CreateNatGatewayResponse' {} Maybe NatGateway
a -> CreateNatGatewayResponse
s {$sel:natGateway:CreateNatGatewayResponse' :: Maybe NatGateway
natGateway = Maybe NatGateway
a} :: CreateNatGatewayResponse)

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

instance Prelude.NFData CreateNatGatewayResponse where
  rnf :: CreateNatGatewayResponse -> ()
rnf CreateNatGatewayResponse' {Int
Maybe Text
Maybe NatGateway
httpStatus :: Int
natGateway :: Maybe NatGateway
clientToken :: Maybe Text
$sel:httpStatus:CreateNatGatewayResponse' :: CreateNatGatewayResponse -> Int
$sel:natGateway:CreateNatGatewayResponse' :: CreateNatGatewayResponse -> Maybe NatGateway
$sel:clientToken:CreateNatGatewayResponse' :: CreateNatGatewayResponse -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
clientToken
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe NatGateway
natGateway
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus