{-# 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.RejectVpcPeeringConnection
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Rejects a VPC peering connection request. The VPC peering connection
-- must be in the @pending-acceptance@ state. Use the
-- DescribeVpcPeeringConnections request to view your outstanding VPC
-- peering connection requests. To delete an active VPC peering connection,
-- or to delete a VPC peering connection request that you initiated, use
-- DeleteVpcPeeringConnection.
module Amazonka.EC2.RejectVpcPeeringConnection
  ( -- * Creating a Request
    RejectVpcPeeringConnection (..),
    newRejectVpcPeeringConnection,

    -- * Request Lenses
    rejectVpcPeeringConnection_dryRun,
    rejectVpcPeeringConnection_vpcPeeringConnectionId,

    -- * Destructuring the Response
    RejectVpcPeeringConnectionResponse (..),
    newRejectVpcPeeringConnectionResponse,

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

-- |
-- Create a value of 'RejectVpcPeeringConnection' 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', 'rejectVpcPeeringConnection_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', 'rejectVpcPeeringConnection_vpcPeeringConnectionId' - The ID of the VPC peering connection.
newRejectVpcPeeringConnection ::
  -- | 'vpcPeeringConnectionId'
  Prelude.Text ->
  RejectVpcPeeringConnection
newRejectVpcPeeringConnection :: Text -> RejectVpcPeeringConnection
newRejectVpcPeeringConnection
  Text
pVpcPeeringConnectionId_ =
    RejectVpcPeeringConnection'
      { $sel:dryRun:RejectVpcPeeringConnection' :: Maybe Bool
dryRun =
          forall a. Maybe a
Prelude.Nothing,
        $sel:vpcPeeringConnectionId:RejectVpcPeeringConnection' :: Text
vpcPeeringConnectionId =
          Text
pVpcPeeringConnectionId_
      }

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

-- | The ID of the VPC peering connection.
rejectVpcPeeringConnection_vpcPeeringConnectionId :: Lens.Lens' RejectVpcPeeringConnection Prelude.Text
rejectVpcPeeringConnection_vpcPeeringConnectionId :: Lens' RejectVpcPeeringConnection Text
rejectVpcPeeringConnection_vpcPeeringConnectionId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\RejectVpcPeeringConnection' {Text
vpcPeeringConnectionId :: Text
$sel:vpcPeeringConnectionId:RejectVpcPeeringConnection' :: RejectVpcPeeringConnection -> Text
vpcPeeringConnectionId} -> Text
vpcPeeringConnectionId) (\s :: RejectVpcPeeringConnection
s@RejectVpcPeeringConnection' {} Text
a -> RejectVpcPeeringConnection
s {$sel:vpcPeeringConnectionId:RejectVpcPeeringConnection' :: Text
vpcPeeringConnectionId = Text
a} :: RejectVpcPeeringConnection)

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

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

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

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

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

-- | /See:/ 'newRejectVpcPeeringConnectionResponse' smart constructor.
data RejectVpcPeeringConnectionResponse = RejectVpcPeeringConnectionResponse'
  { -- | Returns @true@ if the request succeeds; otherwise, it returns an error.
    RejectVpcPeeringConnectionResponse -> Maybe Bool
return' :: Prelude.Maybe Prelude.Bool,
    -- | The response's http status code.
    RejectVpcPeeringConnectionResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (RejectVpcPeeringConnectionResponse
-> RejectVpcPeeringConnectionResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RejectVpcPeeringConnectionResponse
-> RejectVpcPeeringConnectionResponse -> Bool
$c/= :: RejectVpcPeeringConnectionResponse
-> RejectVpcPeeringConnectionResponse -> Bool
== :: RejectVpcPeeringConnectionResponse
-> RejectVpcPeeringConnectionResponse -> Bool
$c== :: RejectVpcPeeringConnectionResponse
-> RejectVpcPeeringConnectionResponse -> Bool
Prelude.Eq, ReadPrec [RejectVpcPeeringConnectionResponse]
ReadPrec RejectVpcPeeringConnectionResponse
Int -> ReadS RejectVpcPeeringConnectionResponse
ReadS [RejectVpcPeeringConnectionResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [RejectVpcPeeringConnectionResponse]
$creadListPrec :: ReadPrec [RejectVpcPeeringConnectionResponse]
readPrec :: ReadPrec RejectVpcPeeringConnectionResponse
$creadPrec :: ReadPrec RejectVpcPeeringConnectionResponse
readList :: ReadS [RejectVpcPeeringConnectionResponse]
$creadList :: ReadS [RejectVpcPeeringConnectionResponse]
readsPrec :: Int -> ReadS RejectVpcPeeringConnectionResponse
$creadsPrec :: Int -> ReadS RejectVpcPeeringConnectionResponse
Prelude.Read, Int -> RejectVpcPeeringConnectionResponse -> ShowS
[RejectVpcPeeringConnectionResponse] -> ShowS
RejectVpcPeeringConnectionResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RejectVpcPeeringConnectionResponse] -> ShowS
$cshowList :: [RejectVpcPeeringConnectionResponse] -> ShowS
show :: RejectVpcPeeringConnectionResponse -> String
$cshow :: RejectVpcPeeringConnectionResponse -> String
showsPrec :: Int -> RejectVpcPeeringConnectionResponse -> ShowS
$cshowsPrec :: Int -> RejectVpcPeeringConnectionResponse -> ShowS
Prelude.Show, forall x.
Rep RejectVpcPeeringConnectionResponse x
-> RejectVpcPeeringConnectionResponse
forall x.
RejectVpcPeeringConnectionResponse
-> Rep RejectVpcPeeringConnectionResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep RejectVpcPeeringConnectionResponse x
-> RejectVpcPeeringConnectionResponse
$cfrom :: forall x.
RejectVpcPeeringConnectionResponse
-> Rep RejectVpcPeeringConnectionResponse x
Prelude.Generic)

-- |
-- Create a value of 'RejectVpcPeeringConnectionResponse' 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:
--
-- 'return'', 'rejectVpcPeeringConnectionResponse_return' - Returns @true@ if the request succeeds; otherwise, it returns an error.
--
-- 'httpStatus', 'rejectVpcPeeringConnectionResponse_httpStatus' - The response's http status code.
newRejectVpcPeeringConnectionResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  RejectVpcPeeringConnectionResponse
newRejectVpcPeeringConnectionResponse :: Int -> RejectVpcPeeringConnectionResponse
newRejectVpcPeeringConnectionResponse Int
pHttpStatus_ =
  RejectVpcPeeringConnectionResponse'
    { $sel:return':RejectVpcPeeringConnectionResponse' :: Maybe Bool
return' =
        forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:RejectVpcPeeringConnectionResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | Returns @true@ if the request succeeds; otherwise, it returns an error.
rejectVpcPeeringConnectionResponse_return :: Lens.Lens' RejectVpcPeeringConnectionResponse (Prelude.Maybe Prelude.Bool)
rejectVpcPeeringConnectionResponse_return :: Lens' RejectVpcPeeringConnectionResponse (Maybe Bool)
rejectVpcPeeringConnectionResponse_return = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\RejectVpcPeeringConnectionResponse' {Maybe Bool
return' :: Maybe Bool
$sel:return':RejectVpcPeeringConnectionResponse' :: RejectVpcPeeringConnectionResponse -> Maybe Bool
return'} -> Maybe Bool
return') (\s :: RejectVpcPeeringConnectionResponse
s@RejectVpcPeeringConnectionResponse' {} Maybe Bool
a -> RejectVpcPeeringConnectionResponse
s {$sel:return':RejectVpcPeeringConnectionResponse' :: Maybe Bool
return' = Maybe Bool
a} :: RejectVpcPeeringConnectionResponse)

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

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