{-# 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.GetApiKeys
-- 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 information about the current ApiKeys resource.
--
-- This operation returns paginated results.
module Amazonka.APIGateway.GetApiKeys
  ( -- * Creating a Request
    GetApiKeys (..),
    newGetApiKeys,

    -- * Request Lenses
    getApiKeys_customerId,
    getApiKeys_includeValues,
    getApiKeys_limit,
    getApiKeys_nameQuery,
    getApiKeys_position,

    -- * Destructuring the Response
    GetApiKeysResponse (..),
    newGetApiKeysResponse,

    -- * Response Lenses
    getApiKeysResponse_items,
    getApiKeysResponse_position,
    getApiKeysResponse_warnings,
    getApiKeysResponse_httpStatus,
  )
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

-- | A request to get information about the current ApiKeys resource.
--
-- /See:/ 'newGetApiKeys' smart constructor.
data GetApiKeys = GetApiKeys'
  { -- | The identifier of a customer in AWS Marketplace or an external system,
    -- such as a developer portal.
    GetApiKeys -> Maybe Text
customerId :: Prelude.Maybe Prelude.Text,
    -- | A boolean flag to specify whether (@true@) or not (@false@) the result
    -- contains key values.
    GetApiKeys -> Maybe Bool
includeValues :: Prelude.Maybe Prelude.Bool,
    -- | The maximum number of returned results per page. The default value is 25
    -- and the maximum value is 500.
    GetApiKeys -> Maybe Int
limit :: Prelude.Maybe Prelude.Int,
    -- | The name of queried API keys.
    GetApiKeys -> Maybe Text
nameQuery :: Prelude.Maybe Prelude.Text,
    -- | The current pagination position in the paged result set.
    GetApiKeys -> Maybe Text
position :: Prelude.Maybe Prelude.Text
  }
  deriving (GetApiKeys -> GetApiKeys -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetApiKeys -> GetApiKeys -> Bool
$c/= :: GetApiKeys -> GetApiKeys -> Bool
== :: GetApiKeys -> GetApiKeys -> Bool
$c== :: GetApiKeys -> GetApiKeys -> Bool
Prelude.Eq, ReadPrec [GetApiKeys]
ReadPrec GetApiKeys
Int -> ReadS GetApiKeys
ReadS [GetApiKeys]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GetApiKeys]
$creadListPrec :: ReadPrec [GetApiKeys]
readPrec :: ReadPrec GetApiKeys
$creadPrec :: ReadPrec GetApiKeys
readList :: ReadS [GetApiKeys]
$creadList :: ReadS [GetApiKeys]
readsPrec :: Int -> ReadS GetApiKeys
$creadsPrec :: Int -> ReadS GetApiKeys
Prelude.Read, Int -> GetApiKeys -> ShowS
[GetApiKeys] -> ShowS
GetApiKeys -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetApiKeys] -> ShowS
$cshowList :: [GetApiKeys] -> ShowS
show :: GetApiKeys -> String
$cshow :: GetApiKeys -> String
showsPrec :: Int -> GetApiKeys -> ShowS
$cshowsPrec :: Int -> GetApiKeys -> ShowS
Prelude.Show, forall x. Rep GetApiKeys x -> GetApiKeys
forall x. GetApiKeys -> Rep GetApiKeys x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep GetApiKeys x -> GetApiKeys
$cfrom :: forall x. GetApiKeys -> Rep GetApiKeys x
Prelude.Generic)

-- |
-- Create a value of 'GetApiKeys' 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:
--
-- 'customerId', 'getApiKeys_customerId' - The identifier of a customer in AWS Marketplace or an external system,
-- such as a developer portal.
--
-- 'includeValues', 'getApiKeys_includeValues' - A boolean flag to specify whether (@true@) or not (@false@) the result
-- contains key values.
--
-- 'limit', 'getApiKeys_limit' - The maximum number of returned results per page. The default value is 25
-- and the maximum value is 500.
--
-- 'nameQuery', 'getApiKeys_nameQuery' - The name of queried API keys.
--
-- 'position', 'getApiKeys_position' - The current pagination position in the paged result set.
newGetApiKeys ::
  GetApiKeys
newGetApiKeys :: GetApiKeys
newGetApiKeys =
  GetApiKeys'
    { $sel:customerId:GetApiKeys' :: Maybe Text
customerId = forall a. Maybe a
Prelude.Nothing,
      $sel:includeValues:GetApiKeys' :: Maybe Bool
includeValues = forall a. Maybe a
Prelude.Nothing,
      $sel:limit:GetApiKeys' :: Maybe Int
limit = forall a. Maybe a
Prelude.Nothing,
      $sel:nameQuery:GetApiKeys' :: Maybe Text
nameQuery = forall a. Maybe a
Prelude.Nothing,
      $sel:position:GetApiKeys' :: Maybe Text
position = forall a. Maybe a
Prelude.Nothing
    }

-- | The identifier of a customer in AWS Marketplace or an external system,
-- such as a developer portal.
getApiKeys_customerId :: Lens.Lens' GetApiKeys (Prelude.Maybe Prelude.Text)
getApiKeys_customerId :: Lens' GetApiKeys (Maybe Text)
getApiKeys_customerId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetApiKeys' {Maybe Text
customerId :: Maybe Text
$sel:customerId:GetApiKeys' :: GetApiKeys -> Maybe Text
customerId} -> Maybe Text
customerId) (\s :: GetApiKeys
s@GetApiKeys' {} Maybe Text
a -> GetApiKeys
s {$sel:customerId:GetApiKeys' :: Maybe Text
customerId = Maybe Text
a} :: GetApiKeys)

-- | A boolean flag to specify whether (@true@) or not (@false@) the result
-- contains key values.
getApiKeys_includeValues :: Lens.Lens' GetApiKeys (Prelude.Maybe Prelude.Bool)
getApiKeys_includeValues :: Lens' GetApiKeys (Maybe Bool)
getApiKeys_includeValues = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetApiKeys' {Maybe Bool
includeValues :: Maybe Bool
$sel:includeValues:GetApiKeys' :: GetApiKeys -> Maybe Bool
includeValues} -> Maybe Bool
includeValues) (\s :: GetApiKeys
s@GetApiKeys' {} Maybe Bool
a -> GetApiKeys
s {$sel:includeValues:GetApiKeys' :: Maybe Bool
includeValues = Maybe Bool
a} :: GetApiKeys)

-- | The maximum number of returned results per page. The default value is 25
-- and the maximum value is 500.
getApiKeys_limit :: Lens.Lens' GetApiKeys (Prelude.Maybe Prelude.Int)
getApiKeys_limit :: Lens' GetApiKeys (Maybe Int)
getApiKeys_limit = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetApiKeys' {Maybe Int
limit :: Maybe Int
$sel:limit:GetApiKeys' :: GetApiKeys -> Maybe Int
limit} -> Maybe Int
limit) (\s :: GetApiKeys
s@GetApiKeys' {} Maybe Int
a -> GetApiKeys
s {$sel:limit:GetApiKeys' :: Maybe Int
limit = Maybe Int
a} :: GetApiKeys)

-- | The name of queried API keys.
getApiKeys_nameQuery :: Lens.Lens' GetApiKeys (Prelude.Maybe Prelude.Text)
getApiKeys_nameQuery :: Lens' GetApiKeys (Maybe Text)
getApiKeys_nameQuery = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetApiKeys' {Maybe Text
nameQuery :: Maybe Text
$sel:nameQuery:GetApiKeys' :: GetApiKeys -> Maybe Text
nameQuery} -> Maybe Text
nameQuery) (\s :: GetApiKeys
s@GetApiKeys' {} Maybe Text
a -> GetApiKeys
s {$sel:nameQuery:GetApiKeys' :: Maybe Text
nameQuery = Maybe Text
a} :: GetApiKeys)

-- | The current pagination position in the paged result set.
getApiKeys_position :: Lens.Lens' GetApiKeys (Prelude.Maybe Prelude.Text)
getApiKeys_position :: Lens' GetApiKeys (Maybe Text)
getApiKeys_position = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetApiKeys' {Maybe Text
position :: Maybe Text
$sel:position:GetApiKeys' :: GetApiKeys -> Maybe Text
position} -> Maybe Text
position) (\s :: GetApiKeys
s@GetApiKeys' {} Maybe Text
a -> GetApiKeys
s {$sel:position:GetApiKeys' :: Maybe Text
position = Maybe Text
a} :: GetApiKeys)

instance Core.AWSPager GetApiKeys where
  page :: GetApiKeys -> AWSResponse GetApiKeys -> Maybe GetApiKeys
page GetApiKeys
rq AWSResponse GetApiKeys
rs
    | forall a. AWSTruncated a => a -> Bool
Core.stop
        ( AWSResponse GetApiKeys
rs
            forall s a. s -> Getting (First a) s a -> Maybe a
Lens.^? Lens' GetApiKeysResponse (Maybe Text)
getApiKeysResponse_position
            forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall a b. Prism (Maybe a) (Maybe b) a b
Lens._Just
        ) =
        forall a. Maybe a
Prelude.Nothing
    | forall a. AWSTruncated a => a -> Bool
Core.stop
        ( AWSResponse GetApiKeys
rs
            forall s a. s -> Getting (First a) s a -> Maybe a
Lens.^? Lens' GetApiKeysResponse (Maybe [ApiKey])
getApiKeysResponse_items
            forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall a b. Prism (Maybe a) (Maybe b) a b
Lens._Just
        ) =
        forall a. Maybe a
Prelude.Nothing
    | Bool
Prelude.otherwise =
        forall a. a -> Maybe a
Prelude.Just
          forall a b. (a -> b) -> a -> b
Prelude.$ GetApiKeys
rq
          forall a b. a -> (a -> b) -> b
Prelude.& Lens' GetApiKeys (Maybe Text)
getApiKeys_position
          forall s t a b. ASetter s t a b -> b -> s -> t
Lens..~ AWSResponse GetApiKeys
rs
          forall s a. s -> Getting (First a) s a -> Maybe a
Lens.^? Lens' GetApiKeysResponse (Maybe Text)
getApiKeysResponse_position
          forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall a b. Prism (Maybe a) (Maybe b) a b
Lens._Just

instance Core.AWSRequest GetApiKeys where
  type AWSResponse GetApiKeys = GetApiKeysResponse
  request :: (Service -> Service) -> GetApiKeys -> Request GetApiKeys
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 GetApiKeys
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse GetApiKeys)))
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 [ApiKey]
-> Maybe Text -> Maybe [Text] -> Int -> GetApiKeysResponse
GetApiKeysResponse'
            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
"item" forall (f :: * -> *) a. Functor f => f (Maybe a) -> a -> f a
Core..!@ forall a. Monoid a => a
Prelude.mempty)
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"position")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"warnings" forall (f :: * -> *) a. Functor f => f (Maybe a) -> a -> f a
Core..!@ forall a. Monoid a => a
Prelude.mempty)
            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 GetApiKeys where
  hashWithSalt :: Int -> GetApiKeys -> Int
hashWithSalt Int
_salt GetApiKeys' {Maybe Bool
Maybe Int
Maybe Text
position :: Maybe Text
nameQuery :: Maybe Text
limit :: Maybe Int
includeValues :: Maybe Bool
customerId :: Maybe Text
$sel:position:GetApiKeys' :: GetApiKeys -> Maybe Text
$sel:nameQuery:GetApiKeys' :: GetApiKeys -> Maybe Text
$sel:limit:GetApiKeys' :: GetApiKeys -> Maybe Int
$sel:includeValues:GetApiKeys' :: GetApiKeys -> Maybe Bool
$sel:customerId:GetApiKeys' :: GetApiKeys -> Maybe Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
customerId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Bool
includeValues
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Int
limit
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
nameQuery
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
position

instance Prelude.NFData GetApiKeys where
  rnf :: GetApiKeys -> ()
rnf GetApiKeys' {Maybe Bool
Maybe Int
Maybe Text
position :: Maybe Text
nameQuery :: Maybe Text
limit :: Maybe Int
includeValues :: Maybe Bool
customerId :: Maybe Text
$sel:position:GetApiKeys' :: GetApiKeys -> Maybe Text
$sel:nameQuery:GetApiKeys' :: GetApiKeys -> Maybe Text
$sel:limit:GetApiKeys' :: GetApiKeys -> Maybe Int
$sel:includeValues:GetApiKeys' :: GetApiKeys -> Maybe Bool
$sel:customerId:GetApiKeys' :: GetApiKeys -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
customerId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Bool
includeValues
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Int
limit
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
nameQuery
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
position

instance Data.ToHeaders GetApiKeys where
  toHeaders :: GetApiKeys -> 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 GetApiKeys where
  toPath :: GetApiKeys -> ByteString
toPath = forall a b. a -> b -> a
Prelude.const ByteString
"/apikeys"

instance Data.ToQuery GetApiKeys where
  toQuery :: GetApiKeys -> QueryString
toQuery GetApiKeys' {Maybe Bool
Maybe Int
Maybe Text
position :: Maybe Text
nameQuery :: Maybe Text
limit :: Maybe Int
includeValues :: Maybe Bool
customerId :: Maybe Text
$sel:position:GetApiKeys' :: GetApiKeys -> Maybe Text
$sel:nameQuery:GetApiKeys' :: GetApiKeys -> Maybe Text
$sel:limit:GetApiKeys' :: GetApiKeys -> Maybe Int
$sel:includeValues:GetApiKeys' :: GetApiKeys -> Maybe Bool
$sel:customerId:GetApiKeys' :: GetApiKeys -> Maybe Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"customerId" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Text
customerId,
        ByteString
"includeValues" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Bool
includeValues,
        ByteString
"limit" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Int
limit,
        ByteString
"name" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Text
nameQuery,
        ByteString
"position" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Text
position
      ]

-- | Represents a collection of API keys as represented by an ApiKeys
-- resource.
--
-- /See:/ 'newGetApiKeysResponse' smart constructor.
data GetApiKeysResponse = GetApiKeysResponse'
  { -- | The current page of elements from this collection.
    GetApiKeysResponse -> Maybe [ApiKey]
items :: Prelude.Maybe [ApiKey],
    GetApiKeysResponse -> Maybe Text
position :: Prelude.Maybe Prelude.Text,
    -- | A list of warning messages logged during the import of API keys when the
    -- @failOnWarnings@ option is set to true.
    GetApiKeysResponse -> Maybe [Text]
warnings :: Prelude.Maybe [Prelude.Text],
    -- | The response's http status code.
    GetApiKeysResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (GetApiKeysResponse -> GetApiKeysResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetApiKeysResponse -> GetApiKeysResponse -> Bool
$c/= :: GetApiKeysResponse -> GetApiKeysResponse -> Bool
== :: GetApiKeysResponse -> GetApiKeysResponse -> Bool
$c== :: GetApiKeysResponse -> GetApiKeysResponse -> Bool
Prelude.Eq, ReadPrec [GetApiKeysResponse]
ReadPrec GetApiKeysResponse
Int -> ReadS GetApiKeysResponse
ReadS [GetApiKeysResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GetApiKeysResponse]
$creadListPrec :: ReadPrec [GetApiKeysResponse]
readPrec :: ReadPrec GetApiKeysResponse
$creadPrec :: ReadPrec GetApiKeysResponse
readList :: ReadS [GetApiKeysResponse]
$creadList :: ReadS [GetApiKeysResponse]
readsPrec :: Int -> ReadS GetApiKeysResponse
$creadsPrec :: Int -> ReadS GetApiKeysResponse
Prelude.Read, Int -> GetApiKeysResponse -> ShowS
[GetApiKeysResponse] -> ShowS
GetApiKeysResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetApiKeysResponse] -> ShowS
$cshowList :: [GetApiKeysResponse] -> ShowS
show :: GetApiKeysResponse -> String
$cshow :: GetApiKeysResponse -> String
showsPrec :: Int -> GetApiKeysResponse -> ShowS
$cshowsPrec :: Int -> GetApiKeysResponse -> ShowS
Prelude.Show, forall x. Rep GetApiKeysResponse x -> GetApiKeysResponse
forall x. GetApiKeysResponse -> Rep GetApiKeysResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep GetApiKeysResponse x -> GetApiKeysResponse
$cfrom :: forall x. GetApiKeysResponse -> Rep GetApiKeysResponse x
Prelude.Generic)

-- |
-- Create a value of 'GetApiKeysResponse' 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:
--
-- 'items', 'getApiKeysResponse_items' - The current page of elements from this collection.
--
-- 'position', 'getApiKeysResponse_position' - Undocumented member.
--
-- 'warnings', 'getApiKeysResponse_warnings' - A list of warning messages logged during the import of API keys when the
-- @failOnWarnings@ option is set to true.
--
-- 'httpStatus', 'getApiKeysResponse_httpStatus' - The response's http status code.
newGetApiKeysResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  GetApiKeysResponse
newGetApiKeysResponse :: Int -> GetApiKeysResponse
newGetApiKeysResponse Int
pHttpStatus_ =
  GetApiKeysResponse'
    { $sel:items:GetApiKeysResponse' :: Maybe [ApiKey]
items = forall a. Maybe a
Prelude.Nothing,
      $sel:position:GetApiKeysResponse' :: Maybe Text
position = forall a. Maybe a
Prelude.Nothing,
      $sel:warnings:GetApiKeysResponse' :: Maybe [Text]
warnings = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:GetApiKeysResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | The current page of elements from this collection.
getApiKeysResponse_items :: Lens.Lens' GetApiKeysResponse (Prelude.Maybe [ApiKey])
getApiKeysResponse_items :: Lens' GetApiKeysResponse (Maybe [ApiKey])
getApiKeysResponse_items = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetApiKeysResponse' {Maybe [ApiKey]
items :: Maybe [ApiKey]
$sel:items:GetApiKeysResponse' :: GetApiKeysResponse -> Maybe [ApiKey]
items} -> Maybe [ApiKey]
items) (\s :: GetApiKeysResponse
s@GetApiKeysResponse' {} Maybe [ApiKey]
a -> GetApiKeysResponse
s {$sel:items:GetApiKeysResponse' :: Maybe [ApiKey]
items = Maybe [ApiKey]
a} :: GetApiKeysResponse) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall (f :: * -> *) (g :: * -> *) s t a b.
(Functor f, Functor g) =>
AnIso s t a b -> Iso (f s) (g t) (f a) (g b)
Lens.mapping forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Lens.coerced

-- | Undocumented member.
getApiKeysResponse_position :: Lens.Lens' GetApiKeysResponse (Prelude.Maybe Prelude.Text)
getApiKeysResponse_position :: Lens' GetApiKeysResponse (Maybe Text)
getApiKeysResponse_position = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetApiKeysResponse' {Maybe Text
position :: Maybe Text
$sel:position:GetApiKeysResponse' :: GetApiKeysResponse -> Maybe Text
position} -> Maybe Text
position) (\s :: GetApiKeysResponse
s@GetApiKeysResponse' {} Maybe Text
a -> GetApiKeysResponse
s {$sel:position:GetApiKeysResponse' :: Maybe Text
position = Maybe Text
a} :: GetApiKeysResponse)

-- | A list of warning messages logged during the import of API keys when the
-- @failOnWarnings@ option is set to true.
getApiKeysResponse_warnings :: Lens.Lens' GetApiKeysResponse (Prelude.Maybe [Prelude.Text])
getApiKeysResponse_warnings :: Lens' GetApiKeysResponse (Maybe [Text])
getApiKeysResponse_warnings = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetApiKeysResponse' {Maybe [Text]
warnings :: Maybe [Text]
$sel:warnings:GetApiKeysResponse' :: GetApiKeysResponse -> Maybe [Text]
warnings} -> Maybe [Text]
warnings) (\s :: GetApiKeysResponse
s@GetApiKeysResponse' {} Maybe [Text]
a -> GetApiKeysResponse
s {$sel:warnings:GetApiKeysResponse' :: Maybe [Text]
warnings = Maybe [Text]
a} :: GetApiKeysResponse) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall (f :: * -> *) (g :: * -> *) s t a b.
(Functor f, Functor g) =>
AnIso s t a b -> Iso (f s) (g t) (f a) (g b)
Lens.mapping forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Lens.coerced

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

instance Prelude.NFData GetApiKeysResponse where
  rnf :: GetApiKeysResponse -> ()
rnf GetApiKeysResponse' {Int
Maybe [Text]
Maybe [ApiKey]
Maybe Text
httpStatus :: Int
warnings :: Maybe [Text]
position :: Maybe Text
items :: Maybe [ApiKey]
$sel:httpStatus:GetApiKeysResponse' :: GetApiKeysResponse -> Int
$sel:warnings:GetApiKeysResponse' :: GetApiKeysResponse -> Maybe [Text]
$sel:position:GetApiKeysResponse' :: GetApiKeysResponse -> Maybe Text
$sel:items:GetApiKeysResponse' :: GetApiKeysResponse -> Maybe [ApiKey]
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe [ApiKey]
items
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
position
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [Text]
warnings
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus