{-# 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.CreateVpcPeeringConnection
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Requests a VPC peering connection between two VPCs: a requester VPC that
-- you own and an accepter VPC with which to create the connection. The
-- accepter VPC can belong to another Amazon Web Services account and can
-- be in a different Region to the requester VPC. The requester VPC and
-- accepter VPC cannot have overlapping CIDR blocks.
--
-- Limitations and rules apply to a VPC peering connection. For more
-- information, see the
-- <https://docs.aws.amazon.com/vpc/latest/peering/vpc-peering-basics.html#vpc-peering-limitations limitations>
-- section in the /VPC Peering Guide/.
--
-- The owner of the accepter VPC must accept the peering request to
-- activate the peering connection. The VPC peering connection request
-- expires after 7 days, after which it cannot be accepted or rejected.
--
-- If you create a VPC peering connection request between VPCs with
-- overlapping CIDR blocks, the VPC peering connection has a status of
-- @failed@.
module Amazonka.EC2.CreateVpcPeeringConnection
  ( -- * Creating a Request
    CreateVpcPeeringConnection (..),
    newCreateVpcPeeringConnection,

    -- * Request Lenses
    createVpcPeeringConnection_dryRun,
    createVpcPeeringConnection_peerOwnerId,
    createVpcPeeringConnection_peerRegion,
    createVpcPeeringConnection_peerVpcId,
    createVpcPeeringConnection_tagSpecifications,
    createVpcPeeringConnection_vpcId,

    -- * Destructuring the Response
    CreateVpcPeeringConnectionResponse (..),
    newCreateVpcPeeringConnectionResponse,

    -- * Response Lenses
    createVpcPeeringConnectionResponse_vpcPeeringConnection,
    createVpcPeeringConnectionResponse_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:/ 'newCreateVpcPeeringConnection' smart constructor.
data CreateVpcPeeringConnection = CreateVpcPeeringConnection'
  { -- | 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@.
    CreateVpcPeeringConnection -> Maybe Bool
dryRun :: Prelude.Maybe Prelude.Bool,
    -- | The Amazon Web Services account ID of the owner of the accepter VPC.
    --
    -- Default: Your Amazon Web Services account ID
    CreateVpcPeeringConnection -> Maybe Text
peerOwnerId :: Prelude.Maybe Prelude.Text,
    -- | The Region code for the accepter VPC, if the accepter VPC is located in
    -- a Region other than the Region in which you make the request.
    --
    -- Default: The Region in which you make the request.
    CreateVpcPeeringConnection -> Maybe Text
peerRegion :: Prelude.Maybe Prelude.Text,
    -- | The ID of the VPC with which you are creating the VPC peering
    -- connection. You must specify this parameter in the request.
    CreateVpcPeeringConnection -> Maybe Text
peerVpcId :: Prelude.Maybe Prelude.Text,
    -- | The tags to assign to the peering connection.
    CreateVpcPeeringConnection -> Maybe [TagSpecification]
tagSpecifications :: Prelude.Maybe [TagSpecification],
    -- | The ID of the requester VPC. You must specify this parameter in the
    -- request.
    CreateVpcPeeringConnection -> Maybe Text
vpcId :: Prelude.Maybe Prelude.Text
  }
  deriving (CreateVpcPeeringConnection -> CreateVpcPeeringConnection -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateVpcPeeringConnection -> CreateVpcPeeringConnection -> Bool
$c/= :: CreateVpcPeeringConnection -> CreateVpcPeeringConnection -> Bool
== :: CreateVpcPeeringConnection -> CreateVpcPeeringConnection -> Bool
$c== :: CreateVpcPeeringConnection -> CreateVpcPeeringConnection -> Bool
Prelude.Eq, ReadPrec [CreateVpcPeeringConnection]
ReadPrec CreateVpcPeeringConnection
Int -> ReadS CreateVpcPeeringConnection
ReadS [CreateVpcPeeringConnection]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CreateVpcPeeringConnection]
$creadListPrec :: ReadPrec [CreateVpcPeeringConnection]
readPrec :: ReadPrec CreateVpcPeeringConnection
$creadPrec :: ReadPrec CreateVpcPeeringConnection
readList :: ReadS [CreateVpcPeeringConnection]
$creadList :: ReadS [CreateVpcPeeringConnection]
readsPrec :: Int -> ReadS CreateVpcPeeringConnection
$creadsPrec :: Int -> ReadS CreateVpcPeeringConnection
Prelude.Read, Int -> CreateVpcPeeringConnection -> ShowS
[CreateVpcPeeringConnection] -> ShowS
CreateVpcPeeringConnection -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateVpcPeeringConnection] -> ShowS
$cshowList :: [CreateVpcPeeringConnection] -> ShowS
show :: CreateVpcPeeringConnection -> String
$cshow :: CreateVpcPeeringConnection -> String
showsPrec :: Int -> CreateVpcPeeringConnection -> ShowS
$cshowsPrec :: Int -> CreateVpcPeeringConnection -> ShowS
Prelude.Show, forall x.
Rep CreateVpcPeeringConnection x -> CreateVpcPeeringConnection
forall x.
CreateVpcPeeringConnection -> Rep CreateVpcPeeringConnection x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep CreateVpcPeeringConnection x -> CreateVpcPeeringConnection
$cfrom :: forall x.
CreateVpcPeeringConnection -> Rep CreateVpcPeeringConnection x
Prelude.Generic)

-- |
-- Create a value of 'CreateVpcPeeringConnection' 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:
--
-- 'dryRun', 'createVpcPeeringConnection_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@.
--
-- 'peerOwnerId', 'createVpcPeeringConnection_peerOwnerId' - The Amazon Web Services account ID of the owner of the accepter VPC.
--
-- Default: Your Amazon Web Services account ID
--
-- 'peerRegion', 'createVpcPeeringConnection_peerRegion' - The Region code for the accepter VPC, if the accepter VPC is located in
-- a Region other than the Region in which you make the request.
--
-- Default: The Region in which you make the request.
--
-- 'peerVpcId', 'createVpcPeeringConnection_peerVpcId' - The ID of the VPC with which you are creating the VPC peering
-- connection. You must specify this parameter in the request.
--
-- 'tagSpecifications', 'createVpcPeeringConnection_tagSpecifications' - The tags to assign to the peering connection.
--
-- 'vpcId', 'createVpcPeeringConnection_vpcId' - The ID of the requester VPC. You must specify this parameter in the
-- request.
newCreateVpcPeeringConnection ::
  CreateVpcPeeringConnection
newCreateVpcPeeringConnection :: CreateVpcPeeringConnection
newCreateVpcPeeringConnection =
  CreateVpcPeeringConnection'
    { $sel:dryRun:CreateVpcPeeringConnection' :: Maybe Bool
dryRun =
        forall a. Maybe a
Prelude.Nothing,
      $sel:peerOwnerId:CreateVpcPeeringConnection' :: Maybe Text
peerOwnerId = forall a. Maybe a
Prelude.Nothing,
      $sel:peerRegion:CreateVpcPeeringConnection' :: Maybe Text
peerRegion = forall a. Maybe a
Prelude.Nothing,
      $sel:peerVpcId:CreateVpcPeeringConnection' :: Maybe Text
peerVpcId = forall a. Maybe a
Prelude.Nothing,
      $sel:tagSpecifications:CreateVpcPeeringConnection' :: Maybe [TagSpecification]
tagSpecifications = forall a. Maybe a
Prelude.Nothing,
      $sel:vpcId:CreateVpcPeeringConnection' :: Maybe Text
vpcId = forall a. Maybe a
Prelude.Nothing
    }

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

-- | The Amazon Web Services account ID of the owner of the accepter VPC.
--
-- Default: Your Amazon Web Services account ID
createVpcPeeringConnection_peerOwnerId :: Lens.Lens' CreateVpcPeeringConnection (Prelude.Maybe Prelude.Text)
createVpcPeeringConnection_peerOwnerId :: Lens' CreateVpcPeeringConnection (Maybe Text)
createVpcPeeringConnection_peerOwnerId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateVpcPeeringConnection' {Maybe Text
peerOwnerId :: Maybe Text
$sel:peerOwnerId:CreateVpcPeeringConnection' :: CreateVpcPeeringConnection -> Maybe Text
peerOwnerId} -> Maybe Text
peerOwnerId) (\s :: CreateVpcPeeringConnection
s@CreateVpcPeeringConnection' {} Maybe Text
a -> CreateVpcPeeringConnection
s {$sel:peerOwnerId:CreateVpcPeeringConnection' :: Maybe Text
peerOwnerId = Maybe Text
a} :: CreateVpcPeeringConnection)

-- | The Region code for the accepter VPC, if the accepter VPC is located in
-- a Region other than the Region in which you make the request.
--
-- Default: The Region in which you make the request.
createVpcPeeringConnection_peerRegion :: Lens.Lens' CreateVpcPeeringConnection (Prelude.Maybe Prelude.Text)
createVpcPeeringConnection_peerRegion :: Lens' CreateVpcPeeringConnection (Maybe Text)
createVpcPeeringConnection_peerRegion = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateVpcPeeringConnection' {Maybe Text
peerRegion :: Maybe Text
$sel:peerRegion:CreateVpcPeeringConnection' :: CreateVpcPeeringConnection -> Maybe Text
peerRegion} -> Maybe Text
peerRegion) (\s :: CreateVpcPeeringConnection
s@CreateVpcPeeringConnection' {} Maybe Text
a -> CreateVpcPeeringConnection
s {$sel:peerRegion:CreateVpcPeeringConnection' :: Maybe Text
peerRegion = Maybe Text
a} :: CreateVpcPeeringConnection)

-- | The ID of the VPC with which you are creating the VPC peering
-- connection. You must specify this parameter in the request.
createVpcPeeringConnection_peerVpcId :: Lens.Lens' CreateVpcPeeringConnection (Prelude.Maybe Prelude.Text)
createVpcPeeringConnection_peerVpcId :: Lens' CreateVpcPeeringConnection (Maybe Text)
createVpcPeeringConnection_peerVpcId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateVpcPeeringConnection' {Maybe Text
peerVpcId :: Maybe Text
$sel:peerVpcId:CreateVpcPeeringConnection' :: CreateVpcPeeringConnection -> Maybe Text
peerVpcId} -> Maybe Text
peerVpcId) (\s :: CreateVpcPeeringConnection
s@CreateVpcPeeringConnection' {} Maybe Text
a -> CreateVpcPeeringConnection
s {$sel:peerVpcId:CreateVpcPeeringConnection' :: Maybe Text
peerVpcId = Maybe Text
a} :: CreateVpcPeeringConnection)

-- | The tags to assign to the peering connection.
createVpcPeeringConnection_tagSpecifications :: Lens.Lens' CreateVpcPeeringConnection (Prelude.Maybe [TagSpecification])
createVpcPeeringConnection_tagSpecifications :: Lens' CreateVpcPeeringConnection (Maybe [TagSpecification])
createVpcPeeringConnection_tagSpecifications = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateVpcPeeringConnection' {Maybe [TagSpecification]
tagSpecifications :: Maybe [TagSpecification]
$sel:tagSpecifications:CreateVpcPeeringConnection' :: CreateVpcPeeringConnection -> Maybe [TagSpecification]
tagSpecifications} -> Maybe [TagSpecification]
tagSpecifications) (\s :: CreateVpcPeeringConnection
s@CreateVpcPeeringConnection' {} Maybe [TagSpecification]
a -> CreateVpcPeeringConnection
s {$sel:tagSpecifications:CreateVpcPeeringConnection' :: Maybe [TagSpecification]
tagSpecifications = Maybe [TagSpecification]
a} :: CreateVpcPeeringConnection) 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 requester VPC. You must specify this parameter in the
-- request.
createVpcPeeringConnection_vpcId :: Lens.Lens' CreateVpcPeeringConnection (Prelude.Maybe Prelude.Text)
createVpcPeeringConnection_vpcId :: Lens' CreateVpcPeeringConnection (Maybe Text)
createVpcPeeringConnection_vpcId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateVpcPeeringConnection' {Maybe Text
vpcId :: Maybe Text
$sel:vpcId:CreateVpcPeeringConnection' :: CreateVpcPeeringConnection -> Maybe Text
vpcId} -> Maybe Text
vpcId) (\s :: CreateVpcPeeringConnection
s@CreateVpcPeeringConnection' {} Maybe Text
a -> CreateVpcPeeringConnection
s {$sel:vpcId:CreateVpcPeeringConnection' :: Maybe Text
vpcId = Maybe Text
a} :: CreateVpcPeeringConnection)

instance Core.AWSRequest CreateVpcPeeringConnection where
  type
    AWSResponse CreateVpcPeeringConnection =
      CreateVpcPeeringConnectionResponse
  request :: (Service -> Service)
-> CreateVpcPeeringConnection -> Request CreateVpcPeeringConnection
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 CreateVpcPeeringConnection
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse CreateVpcPeeringConnection)))
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 VpcPeeringConnection
-> Int -> CreateVpcPeeringConnectionResponse
CreateVpcPeeringConnectionResponse'
            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
"vpcPeeringConnection")
            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 CreateVpcPeeringConnection where
  hashWithSalt :: Int -> CreateVpcPeeringConnection -> Int
hashWithSalt Int
_salt CreateVpcPeeringConnection' {Maybe Bool
Maybe [TagSpecification]
Maybe Text
vpcId :: Maybe Text
tagSpecifications :: Maybe [TagSpecification]
peerVpcId :: Maybe Text
peerRegion :: Maybe Text
peerOwnerId :: Maybe Text
dryRun :: Maybe Bool
$sel:vpcId:CreateVpcPeeringConnection' :: CreateVpcPeeringConnection -> Maybe Text
$sel:tagSpecifications:CreateVpcPeeringConnection' :: CreateVpcPeeringConnection -> Maybe [TagSpecification]
$sel:peerVpcId:CreateVpcPeeringConnection' :: CreateVpcPeeringConnection -> Maybe Text
$sel:peerRegion:CreateVpcPeeringConnection' :: CreateVpcPeeringConnection -> Maybe Text
$sel:peerOwnerId:CreateVpcPeeringConnection' :: CreateVpcPeeringConnection -> Maybe Text
$sel:dryRun:CreateVpcPeeringConnection' :: CreateVpcPeeringConnection -> Maybe Bool
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Bool
dryRun
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
peerOwnerId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
peerRegion
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
peerVpcId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [TagSpecification]
tagSpecifications
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
vpcId

instance Prelude.NFData CreateVpcPeeringConnection where
  rnf :: CreateVpcPeeringConnection -> ()
rnf CreateVpcPeeringConnection' {Maybe Bool
Maybe [TagSpecification]
Maybe Text
vpcId :: Maybe Text
tagSpecifications :: Maybe [TagSpecification]
peerVpcId :: Maybe Text
peerRegion :: Maybe Text
peerOwnerId :: Maybe Text
dryRun :: Maybe Bool
$sel:vpcId:CreateVpcPeeringConnection' :: CreateVpcPeeringConnection -> Maybe Text
$sel:tagSpecifications:CreateVpcPeeringConnection' :: CreateVpcPeeringConnection -> Maybe [TagSpecification]
$sel:peerVpcId:CreateVpcPeeringConnection' :: CreateVpcPeeringConnection -> Maybe Text
$sel:peerRegion:CreateVpcPeeringConnection' :: CreateVpcPeeringConnection -> Maybe Text
$sel:peerOwnerId:CreateVpcPeeringConnection' :: CreateVpcPeeringConnection -> Maybe Text
$sel:dryRun:CreateVpcPeeringConnection' :: CreateVpcPeeringConnection -> Maybe Bool
..} =
    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
peerOwnerId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
peerRegion
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
peerVpcId
      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 Maybe Text
vpcId

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

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

instance Data.ToQuery CreateVpcPeeringConnection where
  toQuery :: CreateVpcPeeringConnection -> QueryString
toQuery CreateVpcPeeringConnection' {Maybe Bool
Maybe [TagSpecification]
Maybe Text
vpcId :: Maybe Text
tagSpecifications :: Maybe [TagSpecification]
peerVpcId :: Maybe Text
peerRegion :: Maybe Text
peerOwnerId :: Maybe Text
dryRun :: Maybe Bool
$sel:vpcId:CreateVpcPeeringConnection' :: CreateVpcPeeringConnection -> Maybe Text
$sel:tagSpecifications:CreateVpcPeeringConnection' :: CreateVpcPeeringConnection -> Maybe [TagSpecification]
$sel:peerVpcId:CreateVpcPeeringConnection' :: CreateVpcPeeringConnection -> Maybe Text
$sel:peerRegion:CreateVpcPeeringConnection' :: CreateVpcPeeringConnection -> Maybe Text
$sel:peerOwnerId:CreateVpcPeeringConnection' :: CreateVpcPeeringConnection -> Maybe Text
$sel:dryRun:CreateVpcPeeringConnection' :: CreateVpcPeeringConnection -> Maybe Bool
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"Action"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: (ByteString
"CreateVpcPeeringConnection" :: Prelude.ByteString),
        ByteString
"Version"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: (ByteString
"2016-11-15" :: Prelude.ByteString),
        ByteString
"DryRun" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Bool
dryRun,
        ByteString
"PeerOwnerId" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Text
peerOwnerId,
        ByteString
"PeerRegion" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Text
peerRegion,
        ByteString
"PeerVpcId" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Text
peerVpcId,
        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.=: Maybe Text
vpcId
      ]

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

-- |
-- Create a value of 'CreateVpcPeeringConnectionResponse' 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:
--
-- 'vpcPeeringConnection', 'createVpcPeeringConnectionResponse_vpcPeeringConnection' - Information about the VPC peering connection.
--
-- 'httpStatus', 'createVpcPeeringConnectionResponse_httpStatus' - The response's http status code.
newCreateVpcPeeringConnectionResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  CreateVpcPeeringConnectionResponse
newCreateVpcPeeringConnectionResponse :: Int -> CreateVpcPeeringConnectionResponse
newCreateVpcPeeringConnectionResponse Int
pHttpStatus_ =
  CreateVpcPeeringConnectionResponse'
    { $sel:vpcPeeringConnection:CreateVpcPeeringConnectionResponse' :: Maybe VpcPeeringConnection
vpcPeeringConnection =
        forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:CreateVpcPeeringConnectionResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | Information about the VPC peering connection.
createVpcPeeringConnectionResponse_vpcPeeringConnection :: Lens.Lens' CreateVpcPeeringConnectionResponse (Prelude.Maybe VpcPeeringConnection)
createVpcPeeringConnectionResponse_vpcPeeringConnection :: Lens'
  CreateVpcPeeringConnectionResponse (Maybe VpcPeeringConnection)
createVpcPeeringConnectionResponse_vpcPeeringConnection = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateVpcPeeringConnectionResponse' {Maybe VpcPeeringConnection
vpcPeeringConnection :: Maybe VpcPeeringConnection
$sel:vpcPeeringConnection:CreateVpcPeeringConnectionResponse' :: CreateVpcPeeringConnectionResponse -> Maybe VpcPeeringConnection
vpcPeeringConnection} -> Maybe VpcPeeringConnection
vpcPeeringConnection) (\s :: CreateVpcPeeringConnectionResponse
s@CreateVpcPeeringConnectionResponse' {} Maybe VpcPeeringConnection
a -> CreateVpcPeeringConnectionResponse
s {$sel:vpcPeeringConnection:CreateVpcPeeringConnectionResponse' :: Maybe VpcPeeringConnection
vpcPeeringConnection = Maybe VpcPeeringConnection
a} :: CreateVpcPeeringConnectionResponse)

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

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