{-# 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.WAFRegional.GetRateBasedRule
-- 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 the RateBasedRule that is specified by the @RuleId@ that you
-- included in the @GetRateBasedRule@ request.
module Amazonka.WAFRegional.GetRateBasedRule
  ( -- * Creating a Request
    GetRateBasedRule (..),
    newGetRateBasedRule,

    -- * Request Lenses
    getRateBasedRule_ruleId,

    -- * Destructuring the Response
    GetRateBasedRuleResponse (..),
    newGetRateBasedRuleResponse,

    -- * Response Lenses
    getRateBasedRuleResponse_rule,
    getRateBasedRuleResponse_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.WAFRegional.Types

-- | /See:/ 'newGetRateBasedRule' smart constructor.
data GetRateBasedRule = GetRateBasedRule'
  { -- | The @RuleId@ of the RateBasedRule that you want to get. @RuleId@ is
    -- returned by CreateRateBasedRule and by ListRateBasedRules.
    GetRateBasedRule -> Text
ruleId :: Prelude.Text
  }
  deriving (GetRateBasedRule -> GetRateBasedRule -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetRateBasedRule -> GetRateBasedRule -> Bool
$c/= :: GetRateBasedRule -> GetRateBasedRule -> Bool
== :: GetRateBasedRule -> GetRateBasedRule -> Bool
$c== :: GetRateBasedRule -> GetRateBasedRule -> Bool
Prelude.Eq, ReadPrec [GetRateBasedRule]
ReadPrec GetRateBasedRule
Int -> ReadS GetRateBasedRule
ReadS [GetRateBasedRule]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GetRateBasedRule]
$creadListPrec :: ReadPrec [GetRateBasedRule]
readPrec :: ReadPrec GetRateBasedRule
$creadPrec :: ReadPrec GetRateBasedRule
readList :: ReadS [GetRateBasedRule]
$creadList :: ReadS [GetRateBasedRule]
readsPrec :: Int -> ReadS GetRateBasedRule
$creadsPrec :: Int -> ReadS GetRateBasedRule
Prelude.Read, Int -> GetRateBasedRule -> ShowS
[GetRateBasedRule] -> ShowS
GetRateBasedRule -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetRateBasedRule] -> ShowS
$cshowList :: [GetRateBasedRule] -> ShowS
show :: GetRateBasedRule -> String
$cshow :: GetRateBasedRule -> String
showsPrec :: Int -> GetRateBasedRule -> ShowS
$cshowsPrec :: Int -> GetRateBasedRule -> ShowS
Prelude.Show, forall x. Rep GetRateBasedRule x -> GetRateBasedRule
forall x. GetRateBasedRule -> Rep GetRateBasedRule x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep GetRateBasedRule x -> GetRateBasedRule
$cfrom :: forall x. GetRateBasedRule -> Rep GetRateBasedRule x
Prelude.Generic)

-- |
-- Create a value of 'GetRateBasedRule' 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:
--
-- 'ruleId', 'getRateBasedRule_ruleId' - The @RuleId@ of the RateBasedRule that you want to get. @RuleId@ is
-- returned by CreateRateBasedRule and by ListRateBasedRules.
newGetRateBasedRule ::
  -- | 'ruleId'
  Prelude.Text ->
  GetRateBasedRule
newGetRateBasedRule :: Text -> GetRateBasedRule
newGetRateBasedRule Text
pRuleId_ =
  GetRateBasedRule' {$sel:ruleId:GetRateBasedRule' :: Text
ruleId = Text
pRuleId_}

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

instance Core.AWSRequest GetRateBasedRule where
  type
    AWSResponse GetRateBasedRule =
      GetRateBasedRuleResponse
  request :: (Service -> Service)
-> GetRateBasedRule -> Request GetRateBasedRule
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 GetRateBasedRule
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse GetRateBasedRule)))
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 RateBasedRule -> Int -> GetRateBasedRuleResponse
GetRateBasedRuleResponse'
            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
"Rule")
            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 GetRateBasedRule where
  hashWithSalt :: Int -> GetRateBasedRule -> Int
hashWithSalt Int
_salt GetRateBasedRule' {Text
ruleId :: Text
$sel:ruleId:GetRateBasedRule' :: GetRateBasedRule -> Text
..} =
    Int
_salt forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
ruleId

instance Prelude.NFData GetRateBasedRule where
  rnf :: GetRateBasedRule -> ()
rnf GetRateBasedRule' {Text
ruleId :: Text
$sel:ruleId:GetRateBasedRule' :: GetRateBasedRule -> Text
..} = forall a. NFData a => a -> ()
Prelude.rnf Text
ruleId

instance Data.ToHeaders GetRateBasedRule where
  toHeaders :: GetRateBasedRule -> 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_Regional_20161128.GetRateBasedRule" ::
                          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 GetRateBasedRule where
  toJSON :: GetRateBasedRule -> Value
toJSON GetRateBasedRule' {Text
ruleId :: Text
$sel:ruleId:GetRateBasedRule' :: GetRateBasedRule -> Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [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 GetRateBasedRule where
  toPath :: GetRateBasedRule -> ByteString
toPath = forall a b. a -> b -> a
Prelude.const ByteString
"/"

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

-- | /See:/ 'newGetRateBasedRuleResponse' smart constructor.
data GetRateBasedRuleResponse = GetRateBasedRuleResponse'
  { -- | Information about the RateBasedRule that you specified in the
    -- @GetRateBasedRule@ request.
    GetRateBasedRuleResponse -> Maybe RateBasedRule
rule :: Prelude.Maybe RateBasedRule,
    -- | The response's http status code.
    GetRateBasedRuleResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (GetRateBasedRuleResponse -> GetRateBasedRuleResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetRateBasedRuleResponse -> GetRateBasedRuleResponse -> Bool
$c/= :: GetRateBasedRuleResponse -> GetRateBasedRuleResponse -> Bool
== :: GetRateBasedRuleResponse -> GetRateBasedRuleResponse -> Bool
$c== :: GetRateBasedRuleResponse -> GetRateBasedRuleResponse -> Bool
Prelude.Eq, ReadPrec [GetRateBasedRuleResponse]
ReadPrec GetRateBasedRuleResponse
Int -> ReadS GetRateBasedRuleResponse
ReadS [GetRateBasedRuleResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GetRateBasedRuleResponse]
$creadListPrec :: ReadPrec [GetRateBasedRuleResponse]
readPrec :: ReadPrec GetRateBasedRuleResponse
$creadPrec :: ReadPrec GetRateBasedRuleResponse
readList :: ReadS [GetRateBasedRuleResponse]
$creadList :: ReadS [GetRateBasedRuleResponse]
readsPrec :: Int -> ReadS GetRateBasedRuleResponse
$creadsPrec :: Int -> ReadS GetRateBasedRuleResponse
Prelude.Read, Int -> GetRateBasedRuleResponse -> ShowS
[GetRateBasedRuleResponse] -> ShowS
GetRateBasedRuleResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetRateBasedRuleResponse] -> ShowS
$cshowList :: [GetRateBasedRuleResponse] -> ShowS
show :: GetRateBasedRuleResponse -> String
$cshow :: GetRateBasedRuleResponse -> String
showsPrec :: Int -> GetRateBasedRuleResponse -> ShowS
$cshowsPrec :: Int -> GetRateBasedRuleResponse -> ShowS
Prelude.Show, forall x.
Rep GetRateBasedRuleResponse x -> GetRateBasedRuleResponse
forall x.
GetRateBasedRuleResponse -> Rep GetRateBasedRuleResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep GetRateBasedRuleResponse x -> GetRateBasedRuleResponse
$cfrom :: forall x.
GetRateBasedRuleResponse -> Rep GetRateBasedRuleResponse x
Prelude.Generic)

-- |
-- Create a value of 'GetRateBasedRuleResponse' 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:
--
-- 'rule', 'getRateBasedRuleResponse_rule' - Information about the RateBasedRule that you specified in the
-- @GetRateBasedRule@ request.
--
-- 'httpStatus', 'getRateBasedRuleResponse_httpStatus' - The response's http status code.
newGetRateBasedRuleResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  GetRateBasedRuleResponse
newGetRateBasedRuleResponse :: Int -> GetRateBasedRuleResponse
newGetRateBasedRuleResponse Int
pHttpStatus_ =
  GetRateBasedRuleResponse'
    { $sel:rule:GetRateBasedRuleResponse' :: Maybe RateBasedRule
rule = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:GetRateBasedRuleResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | Information about the RateBasedRule that you specified in the
-- @GetRateBasedRule@ request.
getRateBasedRuleResponse_rule :: Lens.Lens' GetRateBasedRuleResponse (Prelude.Maybe RateBasedRule)
getRateBasedRuleResponse_rule :: Lens' GetRateBasedRuleResponse (Maybe RateBasedRule)
getRateBasedRuleResponse_rule = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetRateBasedRuleResponse' {Maybe RateBasedRule
rule :: Maybe RateBasedRule
$sel:rule:GetRateBasedRuleResponse' :: GetRateBasedRuleResponse -> Maybe RateBasedRule
rule} -> Maybe RateBasedRule
rule) (\s :: GetRateBasedRuleResponse
s@GetRateBasedRuleResponse' {} Maybe RateBasedRule
a -> GetRateBasedRuleResponse
s {$sel:rule:GetRateBasedRuleResponse' :: Maybe RateBasedRule
rule = Maybe RateBasedRule
a} :: GetRateBasedRuleResponse)

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

instance Prelude.NFData GetRateBasedRuleResponse where
  rnf :: GetRateBasedRuleResponse -> ()
rnf GetRateBasedRuleResponse' {Int
Maybe RateBasedRule
httpStatus :: Int
rule :: Maybe RateBasedRule
$sel:httpStatus:GetRateBasedRuleResponse' :: GetRateBasedRuleResponse -> Int
$sel:rule:GetRateBasedRuleResponse' :: GetRateBasedRuleResponse -> Maybe RateBasedRule
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe RateBasedRule
rule
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus