{-# 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.APIGateway.GetUsagePlanKey
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Gets a usage plan key of a given key identifier.
module Amazonka.APIGateway.GetUsagePlanKey
  ( -- * Creating a Request
    GetUsagePlanKey (..),
    newGetUsagePlanKey,

    -- * Request Lenses
    getUsagePlanKey_usagePlanId,
    getUsagePlanKey_keyId,

    -- * Destructuring the Response
    UsagePlanKey (..),
    newUsagePlanKey,

    -- * Response Lenses
    usagePlanKey_id,
    usagePlanKey_name,
    usagePlanKey_type,
    usagePlanKey_value,
  )
where

import Amazonka.APIGateway.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

-- | The GET request to get a usage plan key of a given key identifier.
--
-- /See:/ 'newGetUsagePlanKey' smart constructor.
data GetUsagePlanKey = GetUsagePlanKey'
  { -- | The Id of the UsagePlan resource representing the usage plan containing
    -- the to-be-retrieved UsagePlanKey resource representing a plan customer.
    GetUsagePlanKey -> Text
usagePlanId :: Prelude.Text,
    -- | The key Id of the to-be-retrieved UsagePlanKey resource representing a
    -- plan customer.
    GetUsagePlanKey -> Text
keyId :: Prelude.Text
  }
  deriving (GetUsagePlanKey -> GetUsagePlanKey -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetUsagePlanKey -> GetUsagePlanKey -> Bool
$c/= :: GetUsagePlanKey -> GetUsagePlanKey -> Bool
== :: GetUsagePlanKey -> GetUsagePlanKey -> Bool
$c== :: GetUsagePlanKey -> GetUsagePlanKey -> Bool
Prelude.Eq, ReadPrec [GetUsagePlanKey]
ReadPrec GetUsagePlanKey
Int -> ReadS GetUsagePlanKey
ReadS [GetUsagePlanKey]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GetUsagePlanKey]
$creadListPrec :: ReadPrec [GetUsagePlanKey]
readPrec :: ReadPrec GetUsagePlanKey
$creadPrec :: ReadPrec GetUsagePlanKey
readList :: ReadS [GetUsagePlanKey]
$creadList :: ReadS [GetUsagePlanKey]
readsPrec :: Int -> ReadS GetUsagePlanKey
$creadsPrec :: Int -> ReadS GetUsagePlanKey
Prelude.Read, Int -> GetUsagePlanKey -> ShowS
[GetUsagePlanKey] -> ShowS
GetUsagePlanKey -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetUsagePlanKey] -> ShowS
$cshowList :: [GetUsagePlanKey] -> ShowS
show :: GetUsagePlanKey -> String
$cshow :: GetUsagePlanKey -> String
showsPrec :: Int -> GetUsagePlanKey -> ShowS
$cshowsPrec :: Int -> GetUsagePlanKey -> ShowS
Prelude.Show, forall x. Rep GetUsagePlanKey x -> GetUsagePlanKey
forall x. GetUsagePlanKey -> Rep GetUsagePlanKey x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep GetUsagePlanKey x -> GetUsagePlanKey
$cfrom :: forall x. GetUsagePlanKey -> Rep GetUsagePlanKey x
Prelude.Generic)

-- |
-- Create a value of 'GetUsagePlanKey' 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:
--
-- 'usagePlanId', 'getUsagePlanKey_usagePlanId' - The Id of the UsagePlan resource representing the usage plan containing
-- the to-be-retrieved UsagePlanKey resource representing a plan customer.
--
-- 'keyId', 'getUsagePlanKey_keyId' - The key Id of the to-be-retrieved UsagePlanKey resource representing a
-- plan customer.
newGetUsagePlanKey ::
  -- | 'usagePlanId'
  Prelude.Text ->
  -- | 'keyId'
  Prelude.Text ->
  GetUsagePlanKey
newGetUsagePlanKey :: Text -> Text -> GetUsagePlanKey
newGetUsagePlanKey Text
pUsagePlanId_ Text
pKeyId_ =
  GetUsagePlanKey'
    { $sel:usagePlanId:GetUsagePlanKey' :: Text
usagePlanId = Text
pUsagePlanId_,
      $sel:keyId:GetUsagePlanKey' :: Text
keyId = Text
pKeyId_
    }

-- | The Id of the UsagePlan resource representing the usage plan containing
-- the to-be-retrieved UsagePlanKey resource representing a plan customer.
getUsagePlanKey_usagePlanId :: Lens.Lens' GetUsagePlanKey Prelude.Text
getUsagePlanKey_usagePlanId :: Lens' GetUsagePlanKey Text
getUsagePlanKey_usagePlanId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetUsagePlanKey' {Text
usagePlanId :: Text
$sel:usagePlanId:GetUsagePlanKey' :: GetUsagePlanKey -> Text
usagePlanId} -> Text
usagePlanId) (\s :: GetUsagePlanKey
s@GetUsagePlanKey' {} Text
a -> GetUsagePlanKey
s {$sel:usagePlanId:GetUsagePlanKey' :: Text
usagePlanId = Text
a} :: GetUsagePlanKey)

-- | The key Id of the to-be-retrieved UsagePlanKey resource representing a
-- plan customer.
getUsagePlanKey_keyId :: Lens.Lens' GetUsagePlanKey Prelude.Text
getUsagePlanKey_keyId :: Lens' GetUsagePlanKey Text
getUsagePlanKey_keyId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetUsagePlanKey' {Text
keyId :: Text
$sel:keyId:GetUsagePlanKey' :: GetUsagePlanKey -> Text
keyId} -> Text
keyId) (\s :: GetUsagePlanKey
s@GetUsagePlanKey' {} Text
a -> GetUsagePlanKey
s {$sel:keyId:GetUsagePlanKey' :: Text
keyId = Text
a} :: GetUsagePlanKey)

instance Core.AWSRequest GetUsagePlanKey where
  type AWSResponse GetUsagePlanKey = UsagePlanKey
  request :: (Service -> Service) -> GetUsagePlanKey -> Request GetUsagePlanKey
request Service -> Service
overrides =
    forall a. ToRequest a => Service -> a -> Request a
Request.get (Service -> Service
overrides Service
defaultService)
  response :: forall (m :: * -> *).
MonadResource m =>
(ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy GetUsagePlanKey
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse GetUsagePlanKey)))
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 -> forall a. FromJSON a => Object -> Either String a
Data.eitherParseJSON Object
x)

instance Prelude.Hashable GetUsagePlanKey where
  hashWithSalt :: Int -> GetUsagePlanKey -> Int
hashWithSalt Int
_salt GetUsagePlanKey' {Text
keyId :: Text
usagePlanId :: Text
$sel:keyId:GetUsagePlanKey' :: GetUsagePlanKey -> Text
$sel:usagePlanId:GetUsagePlanKey' :: GetUsagePlanKey -> Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
usagePlanId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
keyId

instance Prelude.NFData GetUsagePlanKey where
  rnf :: GetUsagePlanKey -> ()
rnf GetUsagePlanKey' {Text
keyId :: Text
usagePlanId :: Text
$sel:keyId:GetUsagePlanKey' :: GetUsagePlanKey -> Text
$sel:usagePlanId:GetUsagePlanKey' :: GetUsagePlanKey -> Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Text
usagePlanId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
keyId

instance Data.ToHeaders GetUsagePlanKey where
  toHeaders :: GetUsagePlanKey -> ResponseHeaders
toHeaders =
    forall a b. a -> b -> a
Prelude.const
      ( forall a. Monoid a => [a] -> a
Prelude.mconcat
          [ HeaderName
"Accept"
              forall a. ToHeader a => HeaderName -> a -> ResponseHeaders
Data.=# (ByteString
"application/json" :: Prelude.ByteString)
          ]
      )

instance Data.ToPath GetUsagePlanKey where
  toPath :: GetUsagePlanKey -> ByteString
toPath GetUsagePlanKey' {Text
keyId :: Text
usagePlanId :: Text
$sel:keyId:GetUsagePlanKey' :: GetUsagePlanKey -> Text
$sel:usagePlanId:GetUsagePlanKey' :: GetUsagePlanKey -> Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"/usageplans/",
        forall a. ToByteString a => a -> ByteString
Data.toBS Text
usagePlanId,
        ByteString
"/keys/",
        forall a. ToByteString a => a -> ByteString
Data.toBS Text
keyId
      ]

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