{-# 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 #-}
module Amazonka.APIGateway.GetApiKey
(
GetApiKey (..),
newGetApiKey,
getApiKey_includeValue,
getApiKey_apiKey,
ApiKey (..),
newApiKey,
apiKey_createdDate,
apiKey_customerId,
apiKey_description,
apiKey_enabled,
apiKey_id,
apiKey_lastUpdatedDate,
apiKey_name,
apiKey_stageKeys,
apiKey_tags,
apiKey_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
data GetApiKey = GetApiKey'
{
GetApiKey -> Maybe Bool
includeValue :: Prelude.Maybe Prelude.Bool,
GetApiKey -> Text
apiKey :: Prelude.Text
}
deriving (GetApiKey -> GetApiKey -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetApiKey -> GetApiKey -> Bool
$c/= :: GetApiKey -> GetApiKey -> Bool
== :: GetApiKey -> GetApiKey -> Bool
$c== :: GetApiKey -> GetApiKey -> Bool
Prelude.Eq, ReadPrec [GetApiKey]
ReadPrec GetApiKey
Int -> ReadS GetApiKey
ReadS [GetApiKey]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GetApiKey]
$creadListPrec :: ReadPrec [GetApiKey]
readPrec :: ReadPrec GetApiKey
$creadPrec :: ReadPrec GetApiKey
readList :: ReadS [GetApiKey]
$creadList :: ReadS [GetApiKey]
readsPrec :: Int -> ReadS GetApiKey
$creadsPrec :: Int -> ReadS GetApiKey
Prelude.Read, Int -> GetApiKey -> ShowS
[GetApiKey] -> ShowS
GetApiKey -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetApiKey] -> ShowS
$cshowList :: [GetApiKey] -> ShowS
show :: GetApiKey -> String
$cshow :: GetApiKey -> String
showsPrec :: Int -> GetApiKey -> ShowS
$cshowsPrec :: Int -> GetApiKey -> ShowS
Prelude.Show, forall x. Rep GetApiKey x -> GetApiKey
forall x. GetApiKey -> Rep GetApiKey x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep GetApiKey x -> GetApiKey
$cfrom :: forall x. GetApiKey -> Rep GetApiKey x
Prelude.Generic)
newGetApiKey ::
Prelude.Text ->
GetApiKey
newGetApiKey :: Text -> GetApiKey
newGetApiKey Text
pApiKey_ =
GetApiKey'
{ $sel:includeValue:GetApiKey' :: Maybe Bool
includeValue = forall a. Maybe a
Prelude.Nothing,
$sel:apiKey:GetApiKey' :: Text
apiKey = Text
pApiKey_
}
getApiKey_includeValue :: Lens.Lens' GetApiKey (Prelude.Maybe Prelude.Bool)
getApiKey_includeValue :: Lens' GetApiKey (Maybe Bool)
getApiKey_includeValue = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetApiKey' {Maybe Bool
includeValue :: Maybe Bool
$sel:includeValue:GetApiKey' :: GetApiKey -> Maybe Bool
includeValue} -> Maybe Bool
includeValue) (\s :: GetApiKey
s@GetApiKey' {} Maybe Bool
a -> GetApiKey
s {$sel:includeValue:GetApiKey' :: Maybe Bool
includeValue = Maybe Bool
a} :: GetApiKey)
getApiKey_apiKey :: Lens.Lens' GetApiKey Prelude.Text
getApiKey_apiKey :: Lens' GetApiKey Text
getApiKey_apiKey = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetApiKey' {Text
apiKey :: Text
$sel:apiKey:GetApiKey' :: GetApiKey -> Text
apiKey} -> Text
apiKey) (\s :: GetApiKey
s@GetApiKey' {} Text
a -> GetApiKey
s {$sel:apiKey:GetApiKey' :: Text
apiKey = Text
a} :: GetApiKey)
instance Core.AWSRequest GetApiKey where
type AWSResponse GetApiKey = ApiKey
request :: (Service -> Service) -> GetApiKey -> Request GetApiKey
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 GetApiKey
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse GetApiKey)))
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 GetApiKey where
hashWithSalt :: Int -> GetApiKey -> Int
hashWithSalt Int
_salt GetApiKey' {Maybe Bool
Text
apiKey :: Text
includeValue :: Maybe Bool
$sel:apiKey:GetApiKey' :: GetApiKey -> Text
$sel:includeValue:GetApiKey' :: GetApiKey -> Maybe Bool
..} =
Int
_salt
forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Bool
includeValue
forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
apiKey
instance Prelude.NFData GetApiKey where
rnf :: GetApiKey -> ()
rnf GetApiKey' {Maybe Bool
Text
apiKey :: Text
includeValue :: Maybe Bool
$sel:apiKey:GetApiKey' :: GetApiKey -> Text
$sel:includeValue:GetApiKey' :: GetApiKey -> Maybe Bool
..} =
forall a. NFData a => a -> ()
Prelude.rnf Maybe Bool
includeValue
seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
apiKey
instance Data.ToHeaders GetApiKey where
toHeaders :: GetApiKey -> 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 GetApiKey where
toPath :: GetApiKey -> ByteString
toPath GetApiKey' {Maybe Bool
Text
apiKey :: Text
includeValue :: Maybe Bool
$sel:apiKey:GetApiKey' :: GetApiKey -> Text
$sel:includeValue:GetApiKey' :: GetApiKey -> Maybe Bool
..} =
forall a. Monoid a => [a] -> a
Prelude.mconcat [ByteString
"/apikeys/", forall a. ToByteString a => a -> ByteString
Data.toBS Text
apiKey]
instance Data.ToQuery GetApiKey where
toQuery :: GetApiKey -> QueryString
toQuery GetApiKey' {Maybe Bool
Text
apiKey :: Text
includeValue :: Maybe Bool
$sel:apiKey:GetApiKey' :: GetApiKey -> Text
$sel:includeValue:GetApiKey' :: GetApiKey -> Maybe Bool
..} =
forall a. Monoid a => [a] -> a
Prelude.mconcat
[ByteString
"includeValue" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Bool
includeValue]