{-# 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.Config.DeletePendingAggregationRequest
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Deletes pending authorization requests for a specified aggregator
-- account in a specified region.
module Amazonka.Config.DeletePendingAggregationRequest
  ( -- * Creating a Request
    DeletePendingAggregationRequest (..),
    newDeletePendingAggregationRequest,

    -- * Request Lenses
    deletePendingAggregationRequest_requesterAccountId,
    deletePendingAggregationRequest_requesterAwsRegion,

    -- * Destructuring the Response
    DeletePendingAggregationRequestResponse (..),
    newDeletePendingAggregationRequestResponse,
  )
where

import Amazonka.Config.Types
import qualified Amazonka.Core as Core
import qualified Amazonka.Core.Lens.Internal as Lens
import qualified Amazonka.Data as Data
import qualified Amazonka.Prelude as Prelude
import qualified Amazonka.Request as Request
import qualified Amazonka.Response as Response

-- | /See:/ 'newDeletePendingAggregationRequest' smart constructor.
data DeletePendingAggregationRequest = DeletePendingAggregationRequest'
  { -- | The 12-digit account ID of the account requesting to aggregate data.
    DeletePendingAggregationRequest -> Text
requesterAccountId :: Prelude.Text,
    -- | The region requesting to aggregate data.
    DeletePendingAggregationRequest -> Text
requesterAwsRegion :: Prelude.Text
  }
  deriving (DeletePendingAggregationRequest
-> DeletePendingAggregationRequest -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DeletePendingAggregationRequest
-> DeletePendingAggregationRequest -> Bool
$c/= :: DeletePendingAggregationRequest
-> DeletePendingAggregationRequest -> Bool
== :: DeletePendingAggregationRequest
-> DeletePendingAggregationRequest -> Bool
$c== :: DeletePendingAggregationRequest
-> DeletePendingAggregationRequest -> Bool
Prelude.Eq, ReadPrec [DeletePendingAggregationRequest]
ReadPrec DeletePendingAggregationRequest
Int -> ReadS DeletePendingAggregationRequest
ReadS [DeletePendingAggregationRequest]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DeletePendingAggregationRequest]
$creadListPrec :: ReadPrec [DeletePendingAggregationRequest]
readPrec :: ReadPrec DeletePendingAggregationRequest
$creadPrec :: ReadPrec DeletePendingAggregationRequest
readList :: ReadS [DeletePendingAggregationRequest]
$creadList :: ReadS [DeletePendingAggregationRequest]
readsPrec :: Int -> ReadS DeletePendingAggregationRequest
$creadsPrec :: Int -> ReadS DeletePendingAggregationRequest
Prelude.Read, Int -> DeletePendingAggregationRequest -> ShowS
[DeletePendingAggregationRequest] -> ShowS
DeletePendingAggregationRequest -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DeletePendingAggregationRequest] -> ShowS
$cshowList :: [DeletePendingAggregationRequest] -> ShowS
show :: DeletePendingAggregationRequest -> String
$cshow :: DeletePendingAggregationRequest -> String
showsPrec :: Int -> DeletePendingAggregationRequest -> ShowS
$cshowsPrec :: Int -> DeletePendingAggregationRequest -> ShowS
Prelude.Show, forall x.
Rep DeletePendingAggregationRequest x
-> DeletePendingAggregationRequest
forall x.
DeletePendingAggregationRequest
-> Rep DeletePendingAggregationRequest x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep DeletePendingAggregationRequest x
-> DeletePendingAggregationRequest
$cfrom :: forall x.
DeletePendingAggregationRequest
-> Rep DeletePendingAggregationRequest x
Prelude.Generic)

-- |
-- Create a value of 'DeletePendingAggregationRequest' 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:
--
-- 'requesterAccountId', 'deletePendingAggregationRequest_requesterAccountId' - The 12-digit account ID of the account requesting to aggregate data.
--
-- 'requesterAwsRegion', 'deletePendingAggregationRequest_requesterAwsRegion' - The region requesting to aggregate data.
newDeletePendingAggregationRequest ::
  -- | 'requesterAccountId'
  Prelude.Text ->
  -- | 'requesterAwsRegion'
  Prelude.Text ->
  DeletePendingAggregationRequest
newDeletePendingAggregationRequest :: Text -> Text -> DeletePendingAggregationRequest
newDeletePendingAggregationRequest
  Text
pRequesterAccountId_
  Text
pRequesterAwsRegion_ =
    DeletePendingAggregationRequest'
      { $sel:requesterAccountId:DeletePendingAggregationRequest' :: Text
requesterAccountId =
          Text
pRequesterAccountId_,
        $sel:requesterAwsRegion:DeletePendingAggregationRequest' :: Text
requesterAwsRegion = Text
pRequesterAwsRegion_
      }

-- | The 12-digit account ID of the account requesting to aggregate data.
deletePendingAggregationRequest_requesterAccountId :: Lens.Lens' DeletePendingAggregationRequest Prelude.Text
deletePendingAggregationRequest_requesterAccountId :: Lens' DeletePendingAggregationRequest Text
deletePendingAggregationRequest_requesterAccountId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DeletePendingAggregationRequest' {Text
requesterAccountId :: Text
$sel:requesterAccountId:DeletePendingAggregationRequest' :: DeletePendingAggregationRequest -> Text
requesterAccountId} -> Text
requesterAccountId) (\s :: DeletePendingAggregationRequest
s@DeletePendingAggregationRequest' {} Text
a -> DeletePendingAggregationRequest
s {$sel:requesterAccountId:DeletePendingAggregationRequest' :: Text
requesterAccountId = Text
a} :: DeletePendingAggregationRequest)

-- | The region requesting to aggregate data.
deletePendingAggregationRequest_requesterAwsRegion :: Lens.Lens' DeletePendingAggregationRequest Prelude.Text
deletePendingAggregationRequest_requesterAwsRegion :: Lens' DeletePendingAggregationRequest Text
deletePendingAggregationRequest_requesterAwsRegion = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DeletePendingAggregationRequest' {Text
requesterAwsRegion :: Text
$sel:requesterAwsRegion:DeletePendingAggregationRequest' :: DeletePendingAggregationRequest -> Text
requesterAwsRegion} -> Text
requesterAwsRegion) (\s :: DeletePendingAggregationRequest
s@DeletePendingAggregationRequest' {} Text
a -> DeletePendingAggregationRequest
s {$sel:requesterAwsRegion:DeletePendingAggregationRequest' :: Text
requesterAwsRegion = Text
a} :: DeletePendingAggregationRequest)

instance
  Core.AWSRequest
    DeletePendingAggregationRequest
  where
  type
    AWSResponse DeletePendingAggregationRequest =
      DeletePendingAggregationRequestResponse
  request :: (Service -> Service)
-> DeletePendingAggregationRequest
-> Request DeletePendingAggregationRequest
request Service -> Service
overrides =
    forall a. (ToRequest a, ToJSON a) => Service -> a -> Request a
Request.postJSON (Service -> Service
overrides Service
defaultService)
  response :: forall (m :: * -> *).
MonadResource m =>
(ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy DeletePendingAggregationRequest
-> ClientResponse ClientBody
-> m (Either
        Error
        (ClientResponse (AWSResponse DeletePendingAggregationRequest)))
response =
    forall (m :: * -> *) a.
MonadResource m =>
AWSResponse a
-> (ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy a
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse a)))
Response.receiveNull
      DeletePendingAggregationRequestResponse
DeletePendingAggregationRequestResponse'

instance
  Prelude.Hashable
    DeletePendingAggregationRequest
  where
  hashWithSalt :: Int -> DeletePendingAggregationRequest -> Int
hashWithSalt
    Int
_salt
    DeletePendingAggregationRequest' {Text
requesterAwsRegion :: Text
requesterAccountId :: Text
$sel:requesterAwsRegion:DeletePendingAggregationRequest' :: DeletePendingAggregationRequest -> Text
$sel:requesterAccountId:DeletePendingAggregationRequest' :: DeletePendingAggregationRequest -> Text
..} =
      Int
_salt
        forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
requesterAccountId
        forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
requesterAwsRegion

instance
  Prelude.NFData
    DeletePendingAggregationRequest
  where
  rnf :: DeletePendingAggregationRequest -> ()
rnf DeletePendingAggregationRequest' {Text
requesterAwsRegion :: Text
requesterAccountId :: Text
$sel:requesterAwsRegion:DeletePendingAggregationRequest' :: DeletePendingAggregationRequest -> Text
$sel:requesterAccountId:DeletePendingAggregationRequest' :: DeletePendingAggregationRequest -> Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Text
requesterAccountId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
requesterAwsRegion

instance
  Data.ToHeaders
    DeletePendingAggregationRequest
  where
  toHeaders :: DeletePendingAggregationRequest -> [Header]
toHeaders =
    forall a b. a -> b -> a
Prelude.const
      ( forall a. Monoid a => [a] -> a
Prelude.mconcat
          [ HeaderName
"X-Amz-Target"
              forall a. ToHeader a => HeaderName -> a -> [Header]
Data.=# ( ByteString
"StarlingDoveService.DeletePendingAggregationRequest" ::
                          Prelude.ByteString
                      ),
            HeaderName
"Content-Type"
              forall a. ToHeader a => HeaderName -> a -> [Header]
Data.=# ( ByteString
"application/x-amz-json-1.1" ::
                          Prelude.ByteString
                      )
          ]
      )

instance Data.ToJSON DeletePendingAggregationRequest where
  toJSON :: DeletePendingAggregationRequest -> Value
toJSON DeletePendingAggregationRequest' {Text
requesterAwsRegion :: Text
requesterAccountId :: Text
$sel:requesterAwsRegion:DeletePendingAggregationRequest' :: DeletePendingAggregationRequest -> Text
$sel:requesterAccountId:DeletePendingAggregationRequest' :: DeletePendingAggregationRequest -> Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ forall a. a -> Maybe a
Prelude.Just
              (Key
"RequesterAccountId" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
requesterAccountId),
            forall a. a -> Maybe a
Prelude.Just
              (Key
"RequesterAwsRegion" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
requesterAwsRegion)
          ]
      )

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

instance Data.ToQuery DeletePendingAggregationRequest where
  toQuery :: DeletePendingAggregationRequest -> QueryString
toQuery = forall a b. a -> b -> a
Prelude.const forall a. Monoid a => a
Prelude.mempty

-- | /See:/ 'newDeletePendingAggregationRequestResponse' smart constructor.
data DeletePendingAggregationRequestResponse = DeletePendingAggregationRequestResponse'
  {
  }
  deriving (DeletePendingAggregationRequestResponse
-> DeletePendingAggregationRequestResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DeletePendingAggregationRequestResponse
-> DeletePendingAggregationRequestResponse -> Bool
$c/= :: DeletePendingAggregationRequestResponse
-> DeletePendingAggregationRequestResponse -> Bool
== :: DeletePendingAggregationRequestResponse
-> DeletePendingAggregationRequestResponse -> Bool
$c== :: DeletePendingAggregationRequestResponse
-> DeletePendingAggregationRequestResponse -> Bool
Prelude.Eq, ReadPrec [DeletePendingAggregationRequestResponse]
ReadPrec DeletePendingAggregationRequestResponse
Int -> ReadS DeletePendingAggregationRequestResponse
ReadS [DeletePendingAggregationRequestResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DeletePendingAggregationRequestResponse]
$creadListPrec :: ReadPrec [DeletePendingAggregationRequestResponse]
readPrec :: ReadPrec DeletePendingAggregationRequestResponse
$creadPrec :: ReadPrec DeletePendingAggregationRequestResponse
readList :: ReadS [DeletePendingAggregationRequestResponse]
$creadList :: ReadS [DeletePendingAggregationRequestResponse]
readsPrec :: Int -> ReadS DeletePendingAggregationRequestResponse
$creadsPrec :: Int -> ReadS DeletePendingAggregationRequestResponse
Prelude.Read, Int -> DeletePendingAggregationRequestResponse -> ShowS
[DeletePendingAggregationRequestResponse] -> ShowS
DeletePendingAggregationRequestResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DeletePendingAggregationRequestResponse] -> ShowS
$cshowList :: [DeletePendingAggregationRequestResponse] -> ShowS
show :: DeletePendingAggregationRequestResponse -> String
$cshow :: DeletePendingAggregationRequestResponse -> String
showsPrec :: Int -> DeletePendingAggregationRequestResponse -> ShowS
$cshowsPrec :: Int -> DeletePendingAggregationRequestResponse -> ShowS
Prelude.Show, forall x.
Rep DeletePendingAggregationRequestResponse x
-> DeletePendingAggregationRequestResponse
forall x.
DeletePendingAggregationRequestResponse
-> Rep DeletePendingAggregationRequestResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep DeletePendingAggregationRequestResponse x
-> DeletePendingAggregationRequestResponse
$cfrom :: forall x.
DeletePendingAggregationRequestResponse
-> Rep DeletePendingAggregationRequestResponse x
Prelude.Generic)

-- |
-- Create a value of 'DeletePendingAggregationRequestResponse' 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.
newDeletePendingAggregationRequestResponse ::
  DeletePendingAggregationRequestResponse
newDeletePendingAggregationRequestResponse :: DeletePendingAggregationRequestResponse
newDeletePendingAggregationRequestResponse =
  DeletePendingAggregationRequestResponse
DeletePendingAggregationRequestResponse'

instance
  Prelude.NFData
    DeletePendingAggregationRequestResponse
  where
  rnf :: DeletePendingAggregationRequestResponse -> ()
rnf DeletePendingAggregationRequestResponse
_ = ()