{-# 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.AcceptVpcPeeringConnection
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Accept a VPC peering connection request. To accept a request, the VPC
-- peering connection must be in the @pending-acceptance@ state, and you
-- must be the owner of the peer VPC. Use DescribeVpcPeeringConnections to
-- view your outstanding VPC peering connection requests.
--
-- For an inter-Region VPC peering connection request, you must accept the
-- VPC peering connection in the Region of the accepter VPC.
module Amazonka.EC2.AcceptVpcPeeringConnection
  ( -- * Creating a Request
    AcceptVpcPeeringConnection (..),
    newAcceptVpcPeeringConnection,

    -- * Request Lenses
    acceptVpcPeeringConnection_dryRun,
    acceptVpcPeeringConnection_vpcPeeringConnectionId,

    -- * Destructuring the Response
    AcceptVpcPeeringConnectionResponse (..),
    newAcceptVpcPeeringConnectionResponse,

    -- * Response Lenses
    acceptVpcPeeringConnectionResponse_vpcPeeringConnection,
    acceptVpcPeeringConnectionResponse_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:/ 'newAcceptVpcPeeringConnection' smart constructor.
data AcceptVpcPeeringConnection = AcceptVpcPeeringConnection'
  { -- | 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@.
    AcceptVpcPeeringConnection -> Maybe Bool
dryRun :: Prelude.Maybe Prelude.Bool,
    -- | The ID of the VPC peering connection. You must specify this parameter in
    -- the request.
    AcceptVpcPeeringConnection -> Maybe Text
vpcPeeringConnectionId :: Prelude.Maybe Prelude.Text
  }
  deriving (AcceptVpcPeeringConnection -> AcceptVpcPeeringConnection -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AcceptVpcPeeringConnection -> AcceptVpcPeeringConnection -> Bool
$c/= :: AcceptVpcPeeringConnection -> AcceptVpcPeeringConnection -> Bool
== :: AcceptVpcPeeringConnection -> AcceptVpcPeeringConnection -> Bool
$c== :: AcceptVpcPeeringConnection -> AcceptVpcPeeringConnection -> Bool
Prelude.Eq, ReadPrec [AcceptVpcPeeringConnection]
ReadPrec AcceptVpcPeeringConnection
Int -> ReadS AcceptVpcPeeringConnection
ReadS [AcceptVpcPeeringConnection]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [AcceptVpcPeeringConnection]
$creadListPrec :: ReadPrec [AcceptVpcPeeringConnection]
readPrec :: ReadPrec AcceptVpcPeeringConnection
$creadPrec :: ReadPrec AcceptVpcPeeringConnection
readList :: ReadS [AcceptVpcPeeringConnection]
$creadList :: ReadS [AcceptVpcPeeringConnection]
readsPrec :: Int -> ReadS AcceptVpcPeeringConnection
$creadsPrec :: Int -> ReadS AcceptVpcPeeringConnection
Prelude.Read, Int -> AcceptVpcPeeringConnection -> ShowS
[AcceptVpcPeeringConnection] -> ShowS
AcceptVpcPeeringConnection -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AcceptVpcPeeringConnection] -> ShowS
$cshowList :: [AcceptVpcPeeringConnection] -> ShowS
show :: AcceptVpcPeeringConnection -> String
$cshow :: AcceptVpcPeeringConnection -> String
showsPrec :: Int -> AcceptVpcPeeringConnection -> ShowS
$cshowsPrec :: Int -> AcceptVpcPeeringConnection -> ShowS
Prelude.Show, forall x.
Rep AcceptVpcPeeringConnection x -> AcceptVpcPeeringConnection
forall x.
AcceptVpcPeeringConnection -> Rep AcceptVpcPeeringConnection x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep AcceptVpcPeeringConnection x -> AcceptVpcPeeringConnection
$cfrom :: forall x.
AcceptVpcPeeringConnection -> Rep AcceptVpcPeeringConnection x
Prelude.Generic)

-- |
-- Create a value of 'AcceptVpcPeeringConnection' 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', 'acceptVpcPeeringConnection_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@.
--
-- 'vpcPeeringConnectionId', 'acceptVpcPeeringConnection_vpcPeeringConnectionId' - The ID of the VPC peering connection. You must specify this parameter in
-- the request.
newAcceptVpcPeeringConnection ::
  AcceptVpcPeeringConnection
newAcceptVpcPeeringConnection :: AcceptVpcPeeringConnection
newAcceptVpcPeeringConnection =
  AcceptVpcPeeringConnection'
    { $sel:dryRun:AcceptVpcPeeringConnection' :: Maybe Bool
dryRun =
        forall a. Maybe a
Prelude.Nothing,
      $sel:vpcPeeringConnectionId:AcceptVpcPeeringConnection' :: Maybe Text
vpcPeeringConnectionId = 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@.
acceptVpcPeeringConnection_dryRun :: Lens.Lens' AcceptVpcPeeringConnection (Prelude.Maybe Prelude.Bool)
acceptVpcPeeringConnection_dryRun :: Lens' AcceptVpcPeeringConnection (Maybe Bool)
acceptVpcPeeringConnection_dryRun = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\AcceptVpcPeeringConnection' {Maybe Bool
dryRun :: Maybe Bool
$sel:dryRun:AcceptVpcPeeringConnection' :: AcceptVpcPeeringConnection -> Maybe Bool
dryRun} -> Maybe Bool
dryRun) (\s :: AcceptVpcPeeringConnection
s@AcceptVpcPeeringConnection' {} Maybe Bool
a -> AcceptVpcPeeringConnection
s {$sel:dryRun:AcceptVpcPeeringConnection' :: Maybe Bool
dryRun = Maybe Bool
a} :: AcceptVpcPeeringConnection)

-- | The ID of the VPC peering connection. You must specify this parameter in
-- the request.
acceptVpcPeeringConnection_vpcPeeringConnectionId :: Lens.Lens' AcceptVpcPeeringConnection (Prelude.Maybe Prelude.Text)
acceptVpcPeeringConnection_vpcPeeringConnectionId :: Lens' AcceptVpcPeeringConnection (Maybe Text)
acceptVpcPeeringConnection_vpcPeeringConnectionId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\AcceptVpcPeeringConnection' {Maybe Text
vpcPeeringConnectionId :: Maybe Text
$sel:vpcPeeringConnectionId:AcceptVpcPeeringConnection' :: AcceptVpcPeeringConnection -> Maybe Text
vpcPeeringConnectionId} -> Maybe Text
vpcPeeringConnectionId) (\s :: AcceptVpcPeeringConnection
s@AcceptVpcPeeringConnection' {} Maybe Text
a -> AcceptVpcPeeringConnection
s {$sel:vpcPeeringConnectionId:AcceptVpcPeeringConnection' :: Maybe Text
vpcPeeringConnectionId = Maybe Text
a} :: AcceptVpcPeeringConnection)

instance Core.AWSRequest AcceptVpcPeeringConnection where
  type
    AWSResponse AcceptVpcPeeringConnection =
      AcceptVpcPeeringConnectionResponse
  request :: (Service -> Service)
-> AcceptVpcPeeringConnection -> Request AcceptVpcPeeringConnection
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 AcceptVpcPeeringConnection
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse AcceptVpcPeeringConnection)))
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 -> AcceptVpcPeeringConnectionResponse
AcceptVpcPeeringConnectionResponse'
            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 AcceptVpcPeeringConnection where
  hashWithSalt :: Int -> AcceptVpcPeeringConnection -> Int
hashWithSalt Int
_salt AcceptVpcPeeringConnection' {Maybe Bool
Maybe Text
vpcPeeringConnectionId :: Maybe Text
dryRun :: Maybe Bool
$sel:vpcPeeringConnectionId:AcceptVpcPeeringConnection' :: AcceptVpcPeeringConnection -> Maybe Text
$sel:dryRun:AcceptVpcPeeringConnection' :: AcceptVpcPeeringConnection -> 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
vpcPeeringConnectionId

instance Prelude.NFData AcceptVpcPeeringConnection where
  rnf :: AcceptVpcPeeringConnection -> ()
rnf AcceptVpcPeeringConnection' {Maybe Bool
Maybe Text
vpcPeeringConnectionId :: Maybe Text
dryRun :: Maybe Bool
$sel:vpcPeeringConnectionId:AcceptVpcPeeringConnection' :: AcceptVpcPeeringConnection -> Maybe Text
$sel:dryRun:AcceptVpcPeeringConnection' :: AcceptVpcPeeringConnection -> 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
vpcPeeringConnectionId

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

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

instance Data.ToQuery AcceptVpcPeeringConnection where
  toQuery :: AcceptVpcPeeringConnection -> QueryString
toQuery AcceptVpcPeeringConnection' {Maybe Bool
Maybe Text
vpcPeeringConnectionId :: Maybe Text
dryRun :: Maybe Bool
$sel:vpcPeeringConnectionId:AcceptVpcPeeringConnection' :: AcceptVpcPeeringConnection -> Maybe Text
$sel:dryRun:AcceptVpcPeeringConnection' :: AcceptVpcPeeringConnection -> Maybe Bool
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"Action"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: (ByteString
"AcceptVpcPeeringConnection" :: 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
"VpcPeeringConnectionId"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Text
vpcPeeringConnectionId
      ]

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

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

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

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

instance
  Prelude.NFData
    AcceptVpcPeeringConnectionResponse
  where
  rnf :: AcceptVpcPeeringConnectionResponse -> ()
rnf AcceptVpcPeeringConnectionResponse' {Int
Maybe VpcPeeringConnection
httpStatus :: Int
vpcPeeringConnection :: Maybe VpcPeeringConnection
$sel:httpStatus:AcceptVpcPeeringConnectionResponse' :: AcceptVpcPeeringConnectionResponse -> Int
$sel:vpcPeeringConnection:AcceptVpcPeeringConnectionResponse' :: AcceptVpcPeeringConnectionResponse -> 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