{-# 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.WAF.GetRateBasedRuleManagedKeys
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- This is __AWS WAF Classic__ documentation. For more information, see
-- <https://docs.aws.amazon.com/waf/latest/developerguide/classic-waf-chapter.html AWS WAF Classic>
-- in the developer guide.
--
-- __For the latest version of AWS WAF__, use the AWS WAFV2 API and see the
-- <https://docs.aws.amazon.com/waf/latest/developerguide/waf-chapter.html AWS WAF Developer Guide>.
-- With the latest version, AWS WAF has a single set of endpoints for
-- regional and global use.
--
-- Returns an array of IP addresses currently being blocked by the
-- RateBasedRule that is specified by the @RuleId@. The maximum number of
-- managed keys that will be blocked is 10,000. If more than 10,000
-- addresses exceed the rate limit, the 10,000 addresses with the highest
-- rates will be blocked.
--
-- This operation returns paginated results.
module Amazonka.WAF.GetRateBasedRuleManagedKeys
  ( -- * Creating a Request
    GetRateBasedRuleManagedKeys (..),
    newGetRateBasedRuleManagedKeys,

    -- * Request Lenses
    getRateBasedRuleManagedKeys_nextMarker,
    getRateBasedRuleManagedKeys_ruleId,

    -- * Destructuring the Response
    GetRateBasedRuleManagedKeysResponse (..),
    newGetRateBasedRuleManagedKeysResponse,

    -- * Response Lenses
    getRateBasedRuleManagedKeysResponse_managedKeys,
    getRateBasedRuleManagedKeysResponse_nextMarker,
    getRateBasedRuleManagedKeysResponse_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.WAF.Types

-- | /See:/ 'newGetRateBasedRuleManagedKeys' smart constructor.
data GetRateBasedRuleManagedKeys = GetRateBasedRuleManagedKeys'
  { -- | A null value and not currently used. Do not include this in your
    -- request.
    GetRateBasedRuleManagedKeys -> Maybe Text
nextMarker :: Prelude.Maybe Prelude.Text,
    -- | The @RuleId@ of the RateBasedRule for which you want to get a list of
    -- @ManagedKeys@. @RuleId@ is returned by CreateRateBasedRule and by
    -- ListRateBasedRules.
    GetRateBasedRuleManagedKeys -> Text
ruleId :: Prelude.Text
  }
  deriving (GetRateBasedRuleManagedKeys -> GetRateBasedRuleManagedKeys -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetRateBasedRuleManagedKeys -> GetRateBasedRuleManagedKeys -> Bool
$c/= :: GetRateBasedRuleManagedKeys -> GetRateBasedRuleManagedKeys -> Bool
== :: GetRateBasedRuleManagedKeys -> GetRateBasedRuleManagedKeys -> Bool
$c== :: GetRateBasedRuleManagedKeys -> GetRateBasedRuleManagedKeys -> Bool
Prelude.Eq, ReadPrec [GetRateBasedRuleManagedKeys]
ReadPrec GetRateBasedRuleManagedKeys
Int -> ReadS GetRateBasedRuleManagedKeys
ReadS [GetRateBasedRuleManagedKeys]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GetRateBasedRuleManagedKeys]
$creadListPrec :: ReadPrec [GetRateBasedRuleManagedKeys]
readPrec :: ReadPrec GetRateBasedRuleManagedKeys
$creadPrec :: ReadPrec GetRateBasedRuleManagedKeys
readList :: ReadS [GetRateBasedRuleManagedKeys]
$creadList :: ReadS [GetRateBasedRuleManagedKeys]
readsPrec :: Int -> ReadS GetRateBasedRuleManagedKeys
$creadsPrec :: Int -> ReadS GetRateBasedRuleManagedKeys
Prelude.Read, Int -> GetRateBasedRuleManagedKeys -> ShowS
[GetRateBasedRuleManagedKeys] -> ShowS
GetRateBasedRuleManagedKeys -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetRateBasedRuleManagedKeys] -> ShowS
$cshowList :: [GetRateBasedRuleManagedKeys] -> ShowS
show :: GetRateBasedRuleManagedKeys -> String
$cshow :: GetRateBasedRuleManagedKeys -> String
showsPrec :: Int -> GetRateBasedRuleManagedKeys -> ShowS
$cshowsPrec :: Int -> GetRateBasedRuleManagedKeys -> ShowS
Prelude.Show, forall x.
Rep GetRateBasedRuleManagedKeys x -> GetRateBasedRuleManagedKeys
forall x.
GetRateBasedRuleManagedKeys -> Rep GetRateBasedRuleManagedKeys x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep GetRateBasedRuleManagedKeys x -> GetRateBasedRuleManagedKeys
$cfrom :: forall x.
GetRateBasedRuleManagedKeys -> Rep GetRateBasedRuleManagedKeys x
Prelude.Generic)

-- |
-- Create a value of 'GetRateBasedRuleManagedKeys' 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:
--
-- 'nextMarker', 'getRateBasedRuleManagedKeys_nextMarker' - A null value and not currently used. Do not include this in your
-- request.
--
-- 'ruleId', 'getRateBasedRuleManagedKeys_ruleId' - The @RuleId@ of the RateBasedRule for which you want to get a list of
-- @ManagedKeys@. @RuleId@ is returned by CreateRateBasedRule and by
-- ListRateBasedRules.
newGetRateBasedRuleManagedKeys ::
  -- | 'ruleId'
  Prelude.Text ->
  GetRateBasedRuleManagedKeys
newGetRateBasedRuleManagedKeys :: Text -> GetRateBasedRuleManagedKeys
newGetRateBasedRuleManagedKeys Text
pRuleId_ =
  GetRateBasedRuleManagedKeys'
    { $sel:nextMarker:GetRateBasedRuleManagedKeys' :: Maybe Text
nextMarker =
        forall a. Maybe a
Prelude.Nothing,
      $sel:ruleId:GetRateBasedRuleManagedKeys' :: Text
ruleId = Text
pRuleId_
    }

-- | A null value and not currently used. Do not include this in your
-- request.
getRateBasedRuleManagedKeys_nextMarker :: Lens.Lens' GetRateBasedRuleManagedKeys (Prelude.Maybe Prelude.Text)
getRateBasedRuleManagedKeys_nextMarker :: Lens' GetRateBasedRuleManagedKeys (Maybe Text)
getRateBasedRuleManagedKeys_nextMarker = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetRateBasedRuleManagedKeys' {Maybe Text
nextMarker :: Maybe Text
$sel:nextMarker:GetRateBasedRuleManagedKeys' :: GetRateBasedRuleManagedKeys -> Maybe Text
nextMarker} -> Maybe Text
nextMarker) (\s :: GetRateBasedRuleManagedKeys
s@GetRateBasedRuleManagedKeys' {} Maybe Text
a -> GetRateBasedRuleManagedKeys
s {$sel:nextMarker:GetRateBasedRuleManagedKeys' :: Maybe Text
nextMarker = Maybe Text
a} :: GetRateBasedRuleManagedKeys)

-- | The @RuleId@ of the RateBasedRule for which you want to get a list of
-- @ManagedKeys@. @RuleId@ is returned by CreateRateBasedRule and by
-- ListRateBasedRules.
getRateBasedRuleManagedKeys_ruleId :: Lens.Lens' GetRateBasedRuleManagedKeys Prelude.Text
getRateBasedRuleManagedKeys_ruleId :: Lens' GetRateBasedRuleManagedKeys Text
getRateBasedRuleManagedKeys_ruleId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetRateBasedRuleManagedKeys' {Text
ruleId :: Text
$sel:ruleId:GetRateBasedRuleManagedKeys' :: GetRateBasedRuleManagedKeys -> Text
ruleId} -> Text
ruleId) (\s :: GetRateBasedRuleManagedKeys
s@GetRateBasedRuleManagedKeys' {} Text
a -> GetRateBasedRuleManagedKeys
s {$sel:ruleId:GetRateBasedRuleManagedKeys' :: Text
ruleId = Text
a} :: GetRateBasedRuleManagedKeys)

instance Core.AWSPager GetRateBasedRuleManagedKeys where
  page :: GetRateBasedRuleManagedKeys
-> AWSResponse GetRateBasedRuleManagedKeys
-> Maybe GetRateBasedRuleManagedKeys
page GetRateBasedRuleManagedKeys
rq AWSResponse GetRateBasedRuleManagedKeys
rs
    | forall a. AWSTruncated a => a -> Bool
Core.stop
        ( AWSResponse GetRateBasedRuleManagedKeys
rs
            forall s a. s -> Getting (First a) s a -> Maybe a
Lens.^? Lens' GetRateBasedRuleManagedKeysResponse (Maybe Text)
getRateBasedRuleManagedKeysResponse_nextMarker
            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 GetRateBasedRuleManagedKeys
rs
            forall s a. s -> Getting (First a) s a -> Maybe a
Lens.^? Lens' GetRateBasedRuleManagedKeysResponse (Maybe [Text])
getRateBasedRuleManagedKeysResponse_managedKeys
            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.$ GetRateBasedRuleManagedKeys
rq
          forall a b. a -> (a -> b) -> b
Prelude.& Lens' GetRateBasedRuleManagedKeys (Maybe Text)
getRateBasedRuleManagedKeys_nextMarker
          forall s t a b. ASetter s t a b -> b -> s -> t
Lens..~ AWSResponse GetRateBasedRuleManagedKeys
rs
          forall s a. s -> Getting (First a) s a -> Maybe a
Lens.^? Lens' GetRateBasedRuleManagedKeysResponse (Maybe Text)
getRateBasedRuleManagedKeysResponse_nextMarker
          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 GetRateBasedRuleManagedKeys where
  type
    AWSResponse GetRateBasedRuleManagedKeys =
      GetRateBasedRuleManagedKeysResponse
  request :: (Service -> Service)
-> GetRateBasedRuleManagedKeys
-> Request GetRateBasedRuleManagedKeys
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 GetRateBasedRuleManagedKeys
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse GetRateBasedRuleManagedKeys)))
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 [Text]
-> Maybe Text -> Int -> GetRateBasedRuleManagedKeysResponse
GetRateBasedRuleManagedKeysResponse'
            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
"ManagedKeys" 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
"NextMarker")
            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 GetRateBasedRuleManagedKeys where
  hashWithSalt :: Int -> GetRateBasedRuleManagedKeys -> Int
hashWithSalt Int
_salt GetRateBasedRuleManagedKeys' {Maybe Text
Text
ruleId :: Text
nextMarker :: Maybe Text
$sel:ruleId:GetRateBasedRuleManagedKeys' :: GetRateBasedRuleManagedKeys -> Text
$sel:nextMarker:GetRateBasedRuleManagedKeys' :: GetRateBasedRuleManagedKeys -> Maybe Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
nextMarker
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
ruleId

instance Prelude.NFData GetRateBasedRuleManagedKeys where
  rnf :: GetRateBasedRuleManagedKeys -> ()
rnf GetRateBasedRuleManagedKeys' {Maybe Text
Text
ruleId :: Text
nextMarker :: Maybe Text
$sel:ruleId:GetRateBasedRuleManagedKeys' :: GetRateBasedRuleManagedKeys -> Text
$sel:nextMarker:GetRateBasedRuleManagedKeys' :: GetRateBasedRuleManagedKeys -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
nextMarker
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
ruleId

instance Data.ToHeaders GetRateBasedRuleManagedKeys where
  toHeaders :: GetRateBasedRuleManagedKeys -> 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
"AWSWAF_20150824.GetRateBasedRuleManagedKeys" ::
                          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 GetRateBasedRuleManagedKeys where
  toJSON :: GetRateBasedRuleManagedKeys -> Value
toJSON GetRateBasedRuleManagedKeys' {Maybe Text
Text
ruleId :: Text
nextMarker :: Maybe Text
$sel:ruleId:GetRateBasedRuleManagedKeys' :: GetRateBasedRuleManagedKeys -> Text
$sel:nextMarker:GetRateBasedRuleManagedKeys' :: GetRateBasedRuleManagedKeys -> Maybe Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"NextMarker" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe Text
nextMarker,
            forall a. a -> Maybe a
Prelude.Just (Key
"RuleId" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
ruleId)
          ]
      )

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

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

-- | /See:/ 'newGetRateBasedRuleManagedKeysResponse' smart constructor.
data GetRateBasedRuleManagedKeysResponse = GetRateBasedRuleManagedKeysResponse'
  { -- | An array of IP addresses that currently are blocked by the specified
    -- RateBasedRule.
    GetRateBasedRuleManagedKeysResponse -> Maybe [Text]
managedKeys :: Prelude.Maybe [Prelude.Text],
    -- | A null value and not currently used.
    GetRateBasedRuleManagedKeysResponse -> Maybe Text
nextMarker :: Prelude.Maybe Prelude.Text,
    -- | The response's http status code.
    GetRateBasedRuleManagedKeysResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (GetRateBasedRuleManagedKeysResponse
-> GetRateBasedRuleManagedKeysResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetRateBasedRuleManagedKeysResponse
-> GetRateBasedRuleManagedKeysResponse -> Bool
$c/= :: GetRateBasedRuleManagedKeysResponse
-> GetRateBasedRuleManagedKeysResponse -> Bool
== :: GetRateBasedRuleManagedKeysResponse
-> GetRateBasedRuleManagedKeysResponse -> Bool
$c== :: GetRateBasedRuleManagedKeysResponse
-> GetRateBasedRuleManagedKeysResponse -> Bool
Prelude.Eq, ReadPrec [GetRateBasedRuleManagedKeysResponse]
ReadPrec GetRateBasedRuleManagedKeysResponse
Int -> ReadS GetRateBasedRuleManagedKeysResponse
ReadS [GetRateBasedRuleManagedKeysResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GetRateBasedRuleManagedKeysResponse]
$creadListPrec :: ReadPrec [GetRateBasedRuleManagedKeysResponse]
readPrec :: ReadPrec GetRateBasedRuleManagedKeysResponse
$creadPrec :: ReadPrec GetRateBasedRuleManagedKeysResponse
readList :: ReadS [GetRateBasedRuleManagedKeysResponse]
$creadList :: ReadS [GetRateBasedRuleManagedKeysResponse]
readsPrec :: Int -> ReadS GetRateBasedRuleManagedKeysResponse
$creadsPrec :: Int -> ReadS GetRateBasedRuleManagedKeysResponse
Prelude.Read, Int -> GetRateBasedRuleManagedKeysResponse -> ShowS
[GetRateBasedRuleManagedKeysResponse] -> ShowS
GetRateBasedRuleManagedKeysResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetRateBasedRuleManagedKeysResponse] -> ShowS
$cshowList :: [GetRateBasedRuleManagedKeysResponse] -> ShowS
show :: GetRateBasedRuleManagedKeysResponse -> String
$cshow :: GetRateBasedRuleManagedKeysResponse -> String
showsPrec :: Int -> GetRateBasedRuleManagedKeysResponse -> ShowS
$cshowsPrec :: Int -> GetRateBasedRuleManagedKeysResponse -> ShowS
Prelude.Show, forall x.
Rep GetRateBasedRuleManagedKeysResponse x
-> GetRateBasedRuleManagedKeysResponse
forall x.
GetRateBasedRuleManagedKeysResponse
-> Rep GetRateBasedRuleManagedKeysResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep GetRateBasedRuleManagedKeysResponse x
-> GetRateBasedRuleManagedKeysResponse
$cfrom :: forall x.
GetRateBasedRuleManagedKeysResponse
-> Rep GetRateBasedRuleManagedKeysResponse x
Prelude.Generic)

-- |
-- Create a value of 'GetRateBasedRuleManagedKeysResponse' 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:
--
-- 'managedKeys', 'getRateBasedRuleManagedKeysResponse_managedKeys' - An array of IP addresses that currently are blocked by the specified
-- RateBasedRule.
--
-- 'nextMarker', 'getRateBasedRuleManagedKeysResponse_nextMarker' - A null value and not currently used.
--
-- 'httpStatus', 'getRateBasedRuleManagedKeysResponse_httpStatus' - The response's http status code.
newGetRateBasedRuleManagedKeysResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  GetRateBasedRuleManagedKeysResponse
newGetRateBasedRuleManagedKeysResponse :: Int -> GetRateBasedRuleManagedKeysResponse
newGetRateBasedRuleManagedKeysResponse Int
pHttpStatus_ =
  GetRateBasedRuleManagedKeysResponse'
    { $sel:managedKeys:GetRateBasedRuleManagedKeysResponse' :: Maybe [Text]
managedKeys =
        forall a. Maybe a
Prelude.Nothing,
      $sel:nextMarker:GetRateBasedRuleManagedKeysResponse' :: Maybe Text
nextMarker = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:GetRateBasedRuleManagedKeysResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | An array of IP addresses that currently are blocked by the specified
-- RateBasedRule.
getRateBasedRuleManagedKeysResponse_managedKeys :: Lens.Lens' GetRateBasedRuleManagedKeysResponse (Prelude.Maybe [Prelude.Text])
getRateBasedRuleManagedKeysResponse_managedKeys :: Lens' GetRateBasedRuleManagedKeysResponse (Maybe [Text])
getRateBasedRuleManagedKeysResponse_managedKeys = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetRateBasedRuleManagedKeysResponse' {Maybe [Text]
managedKeys :: Maybe [Text]
$sel:managedKeys:GetRateBasedRuleManagedKeysResponse' :: GetRateBasedRuleManagedKeysResponse -> Maybe [Text]
managedKeys} -> Maybe [Text]
managedKeys) (\s :: GetRateBasedRuleManagedKeysResponse
s@GetRateBasedRuleManagedKeysResponse' {} Maybe [Text]
a -> GetRateBasedRuleManagedKeysResponse
s {$sel:managedKeys:GetRateBasedRuleManagedKeysResponse' :: Maybe [Text]
managedKeys = Maybe [Text]
a} :: GetRateBasedRuleManagedKeysResponse) 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

-- | A null value and not currently used.
getRateBasedRuleManagedKeysResponse_nextMarker :: Lens.Lens' GetRateBasedRuleManagedKeysResponse (Prelude.Maybe Prelude.Text)
getRateBasedRuleManagedKeysResponse_nextMarker :: Lens' GetRateBasedRuleManagedKeysResponse (Maybe Text)
getRateBasedRuleManagedKeysResponse_nextMarker = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetRateBasedRuleManagedKeysResponse' {Maybe Text
nextMarker :: Maybe Text
$sel:nextMarker:GetRateBasedRuleManagedKeysResponse' :: GetRateBasedRuleManagedKeysResponse -> Maybe Text
nextMarker} -> Maybe Text
nextMarker) (\s :: GetRateBasedRuleManagedKeysResponse
s@GetRateBasedRuleManagedKeysResponse' {} Maybe Text
a -> GetRateBasedRuleManagedKeysResponse
s {$sel:nextMarker:GetRateBasedRuleManagedKeysResponse' :: Maybe Text
nextMarker = Maybe Text
a} :: GetRateBasedRuleManagedKeysResponse)

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

instance
  Prelude.NFData
    GetRateBasedRuleManagedKeysResponse
  where
  rnf :: GetRateBasedRuleManagedKeysResponse -> ()
rnf GetRateBasedRuleManagedKeysResponse' {Int
Maybe [Text]
Maybe Text
httpStatus :: Int
nextMarker :: Maybe Text
managedKeys :: Maybe [Text]
$sel:httpStatus:GetRateBasedRuleManagedKeysResponse' :: GetRateBasedRuleManagedKeysResponse -> Int
$sel:nextMarker:GetRateBasedRuleManagedKeysResponse' :: GetRateBasedRuleManagedKeysResponse -> Maybe Text
$sel:managedKeys:GetRateBasedRuleManagedKeysResponse' :: GetRateBasedRuleManagedKeysResponse -> Maybe [Text]
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe [Text]
managedKeys
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
nextMarker
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus