{-# 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.CreateUsagePlanKey
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Creates a usage plan key for adding an existing API key to a usage plan.
module Amazonka.APIGateway.CreateUsagePlanKey
  ( -- * Creating a Request
    CreateUsagePlanKey (..),
    newCreateUsagePlanKey,

    -- * Request Lenses
    createUsagePlanKey_usagePlanId,
    createUsagePlanKey_keyId,
    createUsagePlanKey_keyType,

    -- * 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 POST request to create a usage plan key for adding an existing API
-- key to a usage plan.
--
-- /See:/ 'newCreateUsagePlanKey' smart constructor.
data CreateUsagePlanKey = CreateUsagePlanKey'
  { -- | The Id of the UsagePlan resource representing the usage plan containing
    -- the to-be-created UsagePlanKey resource representing a plan customer.
    CreateUsagePlanKey -> Text
usagePlanId :: Prelude.Text,
    -- | The identifier of a UsagePlanKey resource for a plan customer.
    CreateUsagePlanKey -> Text
keyId :: Prelude.Text,
    -- | The type of a UsagePlanKey resource for a plan customer.
    CreateUsagePlanKey -> Text
keyType :: Prelude.Text
  }
  deriving (CreateUsagePlanKey -> CreateUsagePlanKey -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateUsagePlanKey -> CreateUsagePlanKey -> Bool
$c/= :: CreateUsagePlanKey -> CreateUsagePlanKey -> Bool
== :: CreateUsagePlanKey -> CreateUsagePlanKey -> Bool
$c== :: CreateUsagePlanKey -> CreateUsagePlanKey -> Bool
Prelude.Eq, ReadPrec [CreateUsagePlanKey]
ReadPrec CreateUsagePlanKey
Int -> ReadS CreateUsagePlanKey
ReadS [CreateUsagePlanKey]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CreateUsagePlanKey]
$creadListPrec :: ReadPrec [CreateUsagePlanKey]
readPrec :: ReadPrec CreateUsagePlanKey
$creadPrec :: ReadPrec CreateUsagePlanKey
readList :: ReadS [CreateUsagePlanKey]
$creadList :: ReadS [CreateUsagePlanKey]
readsPrec :: Int -> ReadS CreateUsagePlanKey
$creadsPrec :: Int -> ReadS CreateUsagePlanKey
Prelude.Read, Int -> CreateUsagePlanKey -> ShowS
[CreateUsagePlanKey] -> ShowS
CreateUsagePlanKey -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateUsagePlanKey] -> ShowS
$cshowList :: [CreateUsagePlanKey] -> ShowS
show :: CreateUsagePlanKey -> String
$cshow :: CreateUsagePlanKey -> String
showsPrec :: Int -> CreateUsagePlanKey -> ShowS
$cshowsPrec :: Int -> CreateUsagePlanKey -> ShowS
Prelude.Show, forall x. Rep CreateUsagePlanKey x -> CreateUsagePlanKey
forall x. CreateUsagePlanKey -> Rep CreateUsagePlanKey x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CreateUsagePlanKey x -> CreateUsagePlanKey
$cfrom :: forall x. CreateUsagePlanKey -> Rep CreateUsagePlanKey x
Prelude.Generic)

-- |
-- Create a value of 'CreateUsagePlanKey' 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', 'createUsagePlanKey_usagePlanId' - The Id of the UsagePlan resource representing the usage plan containing
-- the to-be-created UsagePlanKey resource representing a plan customer.
--
-- 'keyId', 'createUsagePlanKey_keyId' - The identifier of a UsagePlanKey resource for a plan customer.
--
-- 'keyType', 'createUsagePlanKey_keyType' - The type of a UsagePlanKey resource for a plan customer.
newCreateUsagePlanKey ::
  -- | 'usagePlanId'
  Prelude.Text ->
  -- | 'keyId'
  Prelude.Text ->
  -- | 'keyType'
  Prelude.Text ->
  CreateUsagePlanKey
newCreateUsagePlanKey :: Text -> Text -> Text -> CreateUsagePlanKey
newCreateUsagePlanKey Text
pUsagePlanId_ Text
pKeyId_ Text
pKeyType_ =
  CreateUsagePlanKey'
    { $sel:usagePlanId:CreateUsagePlanKey' :: Text
usagePlanId = Text
pUsagePlanId_,
      $sel:keyId:CreateUsagePlanKey' :: Text
keyId = Text
pKeyId_,
      $sel:keyType:CreateUsagePlanKey' :: Text
keyType = Text
pKeyType_
    }

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

-- | The identifier of a UsagePlanKey resource for a plan customer.
createUsagePlanKey_keyId :: Lens.Lens' CreateUsagePlanKey Prelude.Text
createUsagePlanKey_keyId :: Lens' CreateUsagePlanKey Text
createUsagePlanKey_keyId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateUsagePlanKey' {Text
keyId :: Text
$sel:keyId:CreateUsagePlanKey' :: CreateUsagePlanKey -> Text
keyId} -> Text
keyId) (\s :: CreateUsagePlanKey
s@CreateUsagePlanKey' {} Text
a -> CreateUsagePlanKey
s {$sel:keyId:CreateUsagePlanKey' :: Text
keyId = Text
a} :: CreateUsagePlanKey)

-- | The type of a UsagePlanKey resource for a plan customer.
createUsagePlanKey_keyType :: Lens.Lens' CreateUsagePlanKey Prelude.Text
createUsagePlanKey_keyType :: Lens' CreateUsagePlanKey Text
createUsagePlanKey_keyType = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateUsagePlanKey' {Text
keyType :: Text
$sel:keyType:CreateUsagePlanKey' :: CreateUsagePlanKey -> Text
keyType} -> Text
keyType) (\s :: CreateUsagePlanKey
s@CreateUsagePlanKey' {} Text
a -> CreateUsagePlanKey
s {$sel:keyType:CreateUsagePlanKey' :: Text
keyType = Text
a} :: CreateUsagePlanKey)

instance Core.AWSRequest CreateUsagePlanKey where
  type AWSResponse CreateUsagePlanKey = UsagePlanKey
  request :: (Service -> Service)
-> CreateUsagePlanKey -> Request CreateUsagePlanKey
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 CreateUsagePlanKey
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse CreateUsagePlanKey)))
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 CreateUsagePlanKey where
  hashWithSalt :: Int -> CreateUsagePlanKey -> Int
hashWithSalt Int
_salt CreateUsagePlanKey' {Text
keyType :: Text
keyId :: Text
usagePlanId :: Text
$sel:keyType:CreateUsagePlanKey' :: CreateUsagePlanKey -> Text
$sel:keyId:CreateUsagePlanKey' :: CreateUsagePlanKey -> Text
$sel:usagePlanId:CreateUsagePlanKey' :: CreateUsagePlanKey -> 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
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
keyType

instance Prelude.NFData CreateUsagePlanKey where
  rnf :: CreateUsagePlanKey -> ()
rnf CreateUsagePlanKey' {Text
keyType :: Text
keyId :: Text
usagePlanId :: Text
$sel:keyType:CreateUsagePlanKey' :: CreateUsagePlanKey -> Text
$sel:keyId:CreateUsagePlanKey' :: CreateUsagePlanKey -> Text
$sel:usagePlanId:CreateUsagePlanKey' :: CreateUsagePlanKey -> 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
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
keyType

instance Data.ToHeaders CreateUsagePlanKey where
  toHeaders :: CreateUsagePlanKey -> 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.ToJSON CreateUsagePlanKey where
  toJSON :: CreateUsagePlanKey -> Value
toJSON CreateUsagePlanKey' {Text
keyType :: Text
keyId :: Text
usagePlanId :: Text
$sel:keyType:CreateUsagePlanKey' :: CreateUsagePlanKey -> Text
$sel:keyId:CreateUsagePlanKey' :: CreateUsagePlanKey -> Text
$sel:usagePlanId:CreateUsagePlanKey' :: CreateUsagePlanKey -> Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ forall a. a -> Maybe a
Prelude.Just (Key
"keyId" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
keyId),
            forall a. a -> Maybe a
Prelude.Just (Key
"keyType" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
keyType)
          ]
      )

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

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