{-# 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.ServiceQuotas.GetRequestedServiceQuotaChange
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Retrieves information about the specified quota increase request.
module Amazonka.ServiceQuotas.GetRequestedServiceQuotaChange
  ( -- * Creating a Request
    GetRequestedServiceQuotaChange (..),
    newGetRequestedServiceQuotaChange,

    -- * Request Lenses
    getRequestedServiceQuotaChange_requestId,

    -- * Destructuring the Response
    GetRequestedServiceQuotaChangeResponse (..),
    newGetRequestedServiceQuotaChangeResponse,

    -- * Response Lenses
    getRequestedServiceQuotaChangeResponse_requestedQuota,
    getRequestedServiceQuotaChangeResponse_httpStatus,
  )
where

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
import Amazonka.ServiceQuotas.Types

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

-- |
-- Create a value of 'GetRequestedServiceQuotaChange' 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:
--
-- 'requestId', 'getRequestedServiceQuotaChange_requestId' - The ID of the quota increase request.
newGetRequestedServiceQuotaChange ::
  -- | 'requestId'
  Prelude.Text ->
  GetRequestedServiceQuotaChange
newGetRequestedServiceQuotaChange :: Text -> GetRequestedServiceQuotaChange
newGetRequestedServiceQuotaChange Text
pRequestId_ =
  GetRequestedServiceQuotaChange'
    { $sel:requestId:GetRequestedServiceQuotaChange' :: Text
requestId =
        Text
pRequestId_
    }

-- | The ID of the quota increase request.
getRequestedServiceQuotaChange_requestId :: Lens.Lens' GetRequestedServiceQuotaChange Prelude.Text
getRequestedServiceQuotaChange_requestId :: Lens' GetRequestedServiceQuotaChange Text
getRequestedServiceQuotaChange_requestId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetRequestedServiceQuotaChange' {Text
requestId :: Text
$sel:requestId:GetRequestedServiceQuotaChange' :: GetRequestedServiceQuotaChange -> Text
requestId} -> Text
requestId) (\s :: GetRequestedServiceQuotaChange
s@GetRequestedServiceQuotaChange' {} Text
a -> GetRequestedServiceQuotaChange
s {$sel:requestId:GetRequestedServiceQuotaChange' :: Text
requestId = Text
a} :: GetRequestedServiceQuotaChange)

instance
  Core.AWSRequest
    GetRequestedServiceQuotaChange
  where
  type
    AWSResponse GetRequestedServiceQuotaChange =
      GetRequestedServiceQuotaChangeResponse
  request :: (Service -> Service)
-> GetRequestedServiceQuotaChange
-> Request GetRequestedServiceQuotaChange
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 GetRequestedServiceQuotaChange
-> ClientResponse ClientBody
-> m (Either
        Error
        (ClientResponse (AWSResponse GetRequestedServiceQuotaChange)))
response =
    forall (m :: * -> *) a.
MonadResource m =>
(Int -> ResponseHeaders -> Object -> Either String (AWSResponse a))
-> (ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy a
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse a)))
Response.receiveJSON
      ( \Int
s ResponseHeaders
h Object
x ->
          Maybe RequestedServiceQuotaChange
-> Int -> GetRequestedServiceQuotaChangeResponse
GetRequestedServiceQuotaChangeResponse'
            forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"RequestedQuota")
            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
    GetRequestedServiceQuotaChange
  where
  hashWithSalt :: Int -> GetRequestedServiceQuotaChange -> Int
hashWithSalt
    Int
_salt
    GetRequestedServiceQuotaChange' {Text
requestId :: Text
$sel:requestId:GetRequestedServiceQuotaChange' :: GetRequestedServiceQuotaChange -> Text
..} =
      Int
_salt forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
requestId

instance
  Prelude.NFData
    GetRequestedServiceQuotaChange
  where
  rnf :: GetRequestedServiceQuotaChange -> ()
rnf GetRequestedServiceQuotaChange' {Text
requestId :: Text
$sel:requestId:GetRequestedServiceQuotaChange' :: GetRequestedServiceQuotaChange -> Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Text
requestId

instance
  Data.ToHeaders
    GetRequestedServiceQuotaChange
  where
  toHeaders :: GetRequestedServiceQuotaChange -> ResponseHeaders
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 -> ResponseHeaders
Data.=# ( ByteString
"ServiceQuotasV20190624.GetRequestedServiceQuotaChange" ::
                          Prelude.ByteString
                      ),
            HeaderName
"Content-Type"
              forall a. ToHeader a => HeaderName -> a -> ResponseHeaders
Data.=# ( ByteString
"application/x-amz-json-1.1" ::
                          Prelude.ByteString
                      )
          ]
      )

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

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

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

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

-- |
-- Create a value of 'GetRequestedServiceQuotaChangeResponse' 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:
--
-- 'requestedQuota', 'getRequestedServiceQuotaChangeResponse_requestedQuota' - Information about the quota increase request.
--
-- 'httpStatus', 'getRequestedServiceQuotaChangeResponse_httpStatus' - The response's http status code.
newGetRequestedServiceQuotaChangeResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  GetRequestedServiceQuotaChangeResponse
newGetRequestedServiceQuotaChangeResponse :: Int -> GetRequestedServiceQuotaChangeResponse
newGetRequestedServiceQuotaChangeResponse
  Int
pHttpStatus_ =
    GetRequestedServiceQuotaChangeResponse'
      { $sel:requestedQuota:GetRequestedServiceQuotaChangeResponse' :: Maybe RequestedServiceQuotaChange
requestedQuota =
          forall a. Maybe a
Prelude.Nothing,
        $sel:httpStatus:GetRequestedServiceQuotaChangeResponse' :: Int
httpStatus = Int
pHttpStatus_
      }

-- | Information about the quota increase request.
getRequestedServiceQuotaChangeResponse_requestedQuota :: Lens.Lens' GetRequestedServiceQuotaChangeResponse (Prelude.Maybe RequestedServiceQuotaChange)
getRequestedServiceQuotaChangeResponse_requestedQuota :: Lens'
  GetRequestedServiceQuotaChangeResponse
  (Maybe RequestedServiceQuotaChange)
getRequestedServiceQuotaChangeResponse_requestedQuota = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetRequestedServiceQuotaChangeResponse' {Maybe RequestedServiceQuotaChange
requestedQuota :: Maybe RequestedServiceQuotaChange
$sel:requestedQuota:GetRequestedServiceQuotaChangeResponse' :: GetRequestedServiceQuotaChangeResponse
-> Maybe RequestedServiceQuotaChange
requestedQuota} -> Maybe RequestedServiceQuotaChange
requestedQuota) (\s :: GetRequestedServiceQuotaChangeResponse
s@GetRequestedServiceQuotaChangeResponse' {} Maybe RequestedServiceQuotaChange
a -> GetRequestedServiceQuotaChangeResponse
s {$sel:requestedQuota:GetRequestedServiceQuotaChangeResponse' :: Maybe RequestedServiceQuotaChange
requestedQuota = Maybe RequestedServiceQuotaChange
a} :: GetRequestedServiceQuotaChangeResponse)

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

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