{-# 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.GetByteMatchSet
-- 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 ByteMatchSet specified by @ByteMatchSetId@.
module Amazonka.WAFRegional.GetByteMatchSet
  ( -- * Creating a Request
    GetByteMatchSet (..),
    newGetByteMatchSet,

    -- * Request Lenses
    getByteMatchSet_byteMatchSetId,

    -- * Destructuring the Response
    GetByteMatchSetResponse (..),
    newGetByteMatchSetResponse,

    -- * Response Lenses
    getByteMatchSetResponse_byteMatchSet,
    getByteMatchSetResponse_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:/ 'newGetByteMatchSet' smart constructor.
data GetByteMatchSet = GetByteMatchSet'
  { -- | The @ByteMatchSetId@ of the ByteMatchSet that you want to get.
    -- @ByteMatchSetId@ is returned by CreateByteMatchSet and by
    -- ListByteMatchSets.
    GetByteMatchSet -> Text
byteMatchSetId :: Prelude.Text
  }
  deriving (GetByteMatchSet -> GetByteMatchSet -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetByteMatchSet -> GetByteMatchSet -> Bool
$c/= :: GetByteMatchSet -> GetByteMatchSet -> Bool
== :: GetByteMatchSet -> GetByteMatchSet -> Bool
$c== :: GetByteMatchSet -> GetByteMatchSet -> Bool
Prelude.Eq, ReadPrec [GetByteMatchSet]
ReadPrec GetByteMatchSet
Int -> ReadS GetByteMatchSet
ReadS [GetByteMatchSet]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GetByteMatchSet]
$creadListPrec :: ReadPrec [GetByteMatchSet]
readPrec :: ReadPrec GetByteMatchSet
$creadPrec :: ReadPrec GetByteMatchSet
readList :: ReadS [GetByteMatchSet]
$creadList :: ReadS [GetByteMatchSet]
readsPrec :: Int -> ReadS GetByteMatchSet
$creadsPrec :: Int -> ReadS GetByteMatchSet
Prelude.Read, Int -> GetByteMatchSet -> ShowS
[GetByteMatchSet] -> ShowS
GetByteMatchSet -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetByteMatchSet] -> ShowS
$cshowList :: [GetByteMatchSet] -> ShowS
show :: GetByteMatchSet -> String
$cshow :: GetByteMatchSet -> String
showsPrec :: Int -> GetByteMatchSet -> ShowS
$cshowsPrec :: Int -> GetByteMatchSet -> ShowS
Prelude.Show, forall x. Rep GetByteMatchSet x -> GetByteMatchSet
forall x. GetByteMatchSet -> Rep GetByteMatchSet x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep GetByteMatchSet x -> GetByteMatchSet
$cfrom :: forall x. GetByteMatchSet -> Rep GetByteMatchSet x
Prelude.Generic)

-- |
-- Create a value of 'GetByteMatchSet' 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:
--
-- 'byteMatchSetId', 'getByteMatchSet_byteMatchSetId' - The @ByteMatchSetId@ of the ByteMatchSet that you want to get.
-- @ByteMatchSetId@ is returned by CreateByteMatchSet and by
-- ListByteMatchSets.
newGetByteMatchSet ::
  -- | 'byteMatchSetId'
  Prelude.Text ->
  GetByteMatchSet
newGetByteMatchSet :: Text -> GetByteMatchSet
newGetByteMatchSet Text
pByteMatchSetId_ =
  GetByteMatchSet' {$sel:byteMatchSetId:GetByteMatchSet' :: Text
byteMatchSetId = Text
pByteMatchSetId_}

-- | The @ByteMatchSetId@ of the ByteMatchSet that you want to get.
-- @ByteMatchSetId@ is returned by CreateByteMatchSet and by
-- ListByteMatchSets.
getByteMatchSet_byteMatchSetId :: Lens.Lens' GetByteMatchSet Prelude.Text
getByteMatchSet_byteMatchSetId :: Lens' GetByteMatchSet Text
getByteMatchSet_byteMatchSetId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetByteMatchSet' {Text
byteMatchSetId :: Text
$sel:byteMatchSetId:GetByteMatchSet' :: GetByteMatchSet -> Text
byteMatchSetId} -> Text
byteMatchSetId) (\s :: GetByteMatchSet
s@GetByteMatchSet' {} Text
a -> GetByteMatchSet
s {$sel:byteMatchSetId:GetByteMatchSet' :: Text
byteMatchSetId = Text
a} :: GetByteMatchSet)

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

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

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

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

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

-- | /See:/ 'newGetByteMatchSetResponse' smart constructor.
data GetByteMatchSetResponse = GetByteMatchSetResponse'
  { -- | Information about the ByteMatchSet that you specified in the
    -- @GetByteMatchSet@ request. For more information, see the following
    -- topics:
    --
    -- -   ByteMatchSet: Contains @ByteMatchSetId@, @ByteMatchTuples@, and
    --     @Name@
    --
    -- -   @ByteMatchTuples@: Contains an array of ByteMatchTuple objects. Each
    --     @ByteMatchTuple@ object contains FieldToMatch,
    --     @PositionalConstraint@, @TargetString@, and @TextTransformation@
    --
    -- -   FieldToMatch: Contains @Data@ and @Type@
    GetByteMatchSetResponse -> Maybe ByteMatchSet
byteMatchSet :: Prelude.Maybe ByteMatchSet,
    -- | The response's http status code.
    GetByteMatchSetResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (GetByteMatchSetResponse -> GetByteMatchSetResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetByteMatchSetResponse -> GetByteMatchSetResponse -> Bool
$c/= :: GetByteMatchSetResponse -> GetByteMatchSetResponse -> Bool
== :: GetByteMatchSetResponse -> GetByteMatchSetResponse -> Bool
$c== :: GetByteMatchSetResponse -> GetByteMatchSetResponse -> Bool
Prelude.Eq, ReadPrec [GetByteMatchSetResponse]
ReadPrec GetByteMatchSetResponse
Int -> ReadS GetByteMatchSetResponse
ReadS [GetByteMatchSetResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GetByteMatchSetResponse]
$creadListPrec :: ReadPrec [GetByteMatchSetResponse]
readPrec :: ReadPrec GetByteMatchSetResponse
$creadPrec :: ReadPrec GetByteMatchSetResponse
readList :: ReadS [GetByteMatchSetResponse]
$creadList :: ReadS [GetByteMatchSetResponse]
readsPrec :: Int -> ReadS GetByteMatchSetResponse
$creadsPrec :: Int -> ReadS GetByteMatchSetResponse
Prelude.Read, Int -> GetByteMatchSetResponse -> ShowS
[GetByteMatchSetResponse] -> ShowS
GetByteMatchSetResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetByteMatchSetResponse] -> ShowS
$cshowList :: [GetByteMatchSetResponse] -> ShowS
show :: GetByteMatchSetResponse -> String
$cshow :: GetByteMatchSetResponse -> String
showsPrec :: Int -> GetByteMatchSetResponse -> ShowS
$cshowsPrec :: Int -> GetByteMatchSetResponse -> ShowS
Prelude.Show, forall x. Rep GetByteMatchSetResponse x -> GetByteMatchSetResponse
forall x. GetByteMatchSetResponse -> Rep GetByteMatchSetResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep GetByteMatchSetResponse x -> GetByteMatchSetResponse
$cfrom :: forall x. GetByteMatchSetResponse -> Rep GetByteMatchSetResponse x
Prelude.Generic)

-- |
-- Create a value of 'GetByteMatchSetResponse' 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:
--
-- 'byteMatchSet', 'getByteMatchSetResponse_byteMatchSet' - Information about the ByteMatchSet that you specified in the
-- @GetByteMatchSet@ request. For more information, see the following
-- topics:
--
-- -   ByteMatchSet: Contains @ByteMatchSetId@, @ByteMatchTuples@, and
--     @Name@
--
-- -   @ByteMatchTuples@: Contains an array of ByteMatchTuple objects. Each
--     @ByteMatchTuple@ object contains FieldToMatch,
--     @PositionalConstraint@, @TargetString@, and @TextTransformation@
--
-- -   FieldToMatch: Contains @Data@ and @Type@
--
-- 'httpStatus', 'getByteMatchSetResponse_httpStatus' - The response's http status code.
newGetByteMatchSetResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  GetByteMatchSetResponse
newGetByteMatchSetResponse :: Int -> GetByteMatchSetResponse
newGetByteMatchSetResponse Int
pHttpStatus_ =
  GetByteMatchSetResponse'
    { $sel:byteMatchSet:GetByteMatchSetResponse' :: Maybe ByteMatchSet
byteMatchSet =
        forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:GetByteMatchSetResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | Information about the ByteMatchSet that you specified in the
-- @GetByteMatchSet@ request. For more information, see the following
-- topics:
--
-- -   ByteMatchSet: Contains @ByteMatchSetId@, @ByteMatchTuples@, and
--     @Name@
--
-- -   @ByteMatchTuples@: Contains an array of ByteMatchTuple objects. Each
--     @ByteMatchTuple@ object contains FieldToMatch,
--     @PositionalConstraint@, @TargetString@, and @TextTransformation@
--
-- -   FieldToMatch: Contains @Data@ and @Type@
getByteMatchSetResponse_byteMatchSet :: Lens.Lens' GetByteMatchSetResponse (Prelude.Maybe ByteMatchSet)
getByteMatchSetResponse_byteMatchSet :: Lens' GetByteMatchSetResponse (Maybe ByteMatchSet)
getByteMatchSetResponse_byteMatchSet = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetByteMatchSetResponse' {Maybe ByteMatchSet
byteMatchSet :: Maybe ByteMatchSet
$sel:byteMatchSet:GetByteMatchSetResponse' :: GetByteMatchSetResponse -> Maybe ByteMatchSet
byteMatchSet} -> Maybe ByteMatchSet
byteMatchSet) (\s :: GetByteMatchSetResponse
s@GetByteMatchSetResponse' {} Maybe ByteMatchSet
a -> GetByteMatchSetResponse
s {$sel:byteMatchSet:GetByteMatchSetResponse' :: Maybe ByteMatchSet
byteMatchSet = Maybe ByteMatchSet
a} :: GetByteMatchSetResponse)

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

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