{-# 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.GetLoggingConfiguration
-- 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 LoggingConfiguration for the specified web ACL.
module Amazonka.WAFRegional.GetLoggingConfiguration
  ( -- * Creating a Request
    GetLoggingConfiguration (..),
    newGetLoggingConfiguration,

    -- * Request Lenses
    getLoggingConfiguration_resourceArn,

    -- * Destructuring the Response
    GetLoggingConfigurationResponse (..),
    newGetLoggingConfigurationResponse,

    -- * Response Lenses
    getLoggingConfigurationResponse_loggingConfiguration,
    getLoggingConfigurationResponse_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:/ 'newGetLoggingConfiguration' smart constructor.
data GetLoggingConfiguration = GetLoggingConfiguration'
  { -- | The Amazon Resource Name (ARN) of the web ACL for which you want to get
    -- the LoggingConfiguration.
    GetLoggingConfiguration -> Text
resourceArn :: Prelude.Text
  }
  deriving (GetLoggingConfiguration -> GetLoggingConfiguration -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetLoggingConfiguration -> GetLoggingConfiguration -> Bool
$c/= :: GetLoggingConfiguration -> GetLoggingConfiguration -> Bool
== :: GetLoggingConfiguration -> GetLoggingConfiguration -> Bool
$c== :: GetLoggingConfiguration -> GetLoggingConfiguration -> Bool
Prelude.Eq, ReadPrec [GetLoggingConfiguration]
ReadPrec GetLoggingConfiguration
Int -> ReadS GetLoggingConfiguration
ReadS [GetLoggingConfiguration]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GetLoggingConfiguration]
$creadListPrec :: ReadPrec [GetLoggingConfiguration]
readPrec :: ReadPrec GetLoggingConfiguration
$creadPrec :: ReadPrec GetLoggingConfiguration
readList :: ReadS [GetLoggingConfiguration]
$creadList :: ReadS [GetLoggingConfiguration]
readsPrec :: Int -> ReadS GetLoggingConfiguration
$creadsPrec :: Int -> ReadS GetLoggingConfiguration
Prelude.Read, Int -> GetLoggingConfiguration -> ShowS
[GetLoggingConfiguration] -> ShowS
GetLoggingConfiguration -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetLoggingConfiguration] -> ShowS
$cshowList :: [GetLoggingConfiguration] -> ShowS
show :: GetLoggingConfiguration -> String
$cshow :: GetLoggingConfiguration -> String
showsPrec :: Int -> GetLoggingConfiguration -> ShowS
$cshowsPrec :: Int -> GetLoggingConfiguration -> ShowS
Prelude.Show, forall x. Rep GetLoggingConfiguration x -> GetLoggingConfiguration
forall x. GetLoggingConfiguration -> Rep GetLoggingConfiguration x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep GetLoggingConfiguration x -> GetLoggingConfiguration
$cfrom :: forall x. GetLoggingConfiguration -> Rep GetLoggingConfiguration x
Prelude.Generic)

-- |
-- Create a value of 'GetLoggingConfiguration' 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:
--
-- 'resourceArn', 'getLoggingConfiguration_resourceArn' - The Amazon Resource Name (ARN) of the web ACL for which you want to get
-- the LoggingConfiguration.
newGetLoggingConfiguration ::
  -- | 'resourceArn'
  Prelude.Text ->
  GetLoggingConfiguration
newGetLoggingConfiguration :: Text -> GetLoggingConfiguration
newGetLoggingConfiguration Text
pResourceArn_ =
  GetLoggingConfiguration'
    { $sel:resourceArn:GetLoggingConfiguration' :: Text
resourceArn =
        Text
pResourceArn_
    }

-- | The Amazon Resource Name (ARN) of the web ACL for which you want to get
-- the LoggingConfiguration.
getLoggingConfiguration_resourceArn :: Lens.Lens' GetLoggingConfiguration Prelude.Text
getLoggingConfiguration_resourceArn :: Lens' GetLoggingConfiguration Text
getLoggingConfiguration_resourceArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetLoggingConfiguration' {Text
resourceArn :: Text
$sel:resourceArn:GetLoggingConfiguration' :: GetLoggingConfiguration -> Text
resourceArn} -> Text
resourceArn) (\s :: GetLoggingConfiguration
s@GetLoggingConfiguration' {} Text
a -> GetLoggingConfiguration
s {$sel:resourceArn:GetLoggingConfiguration' :: Text
resourceArn = Text
a} :: GetLoggingConfiguration)

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

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

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

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

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

-- | /See:/ 'newGetLoggingConfigurationResponse' smart constructor.
data GetLoggingConfigurationResponse = GetLoggingConfigurationResponse'
  { -- | The LoggingConfiguration for the specified web ACL.
    GetLoggingConfigurationResponse -> Maybe LoggingConfiguration
loggingConfiguration :: Prelude.Maybe LoggingConfiguration,
    -- | The response's http status code.
    GetLoggingConfigurationResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (GetLoggingConfigurationResponse
-> GetLoggingConfigurationResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetLoggingConfigurationResponse
-> GetLoggingConfigurationResponse -> Bool
$c/= :: GetLoggingConfigurationResponse
-> GetLoggingConfigurationResponse -> Bool
== :: GetLoggingConfigurationResponse
-> GetLoggingConfigurationResponse -> Bool
$c== :: GetLoggingConfigurationResponse
-> GetLoggingConfigurationResponse -> Bool
Prelude.Eq, ReadPrec [GetLoggingConfigurationResponse]
ReadPrec GetLoggingConfigurationResponse
Int -> ReadS GetLoggingConfigurationResponse
ReadS [GetLoggingConfigurationResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GetLoggingConfigurationResponse]
$creadListPrec :: ReadPrec [GetLoggingConfigurationResponse]
readPrec :: ReadPrec GetLoggingConfigurationResponse
$creadPrec :: ReadPrec GetLoggingConfigurationResponse
readList :: ReadS [GetLoggingConfigurationResponse]
$creadList :: ReadS [GetLoggingConfigurationResponse]
readsPrec :: Int -> ReadS GetLoggingConfigurationResponse
$creadsPrec :: Int -> ReadS GetLoggingConfigurationResponse
Prelude.Read, Int -> GetLoggingConfigurationResponse -> ShowS
[GetLoggingConfigurationResponse] -> ShowS
GetLoggingConfigurationResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetLoggingConfigurationResponse] -> ShowS
$cshowList :: [GetLoggingConfigurationResponse] -> ShowS
show :: GetLoggingConfigurationResponse -> String
$cshow :: GetLoggingConfigurationResponse -> String
showsPrec :: Int -> GetLoggingConfigurationResponse -> ShowS
$cshowsPrec :: Int -> GetLoggingConfigurationResponse -> ShowS
Prelude.Show, forall x.
Rep GetLoggingConfigurationResponse x
-> GetLoggingConfigurationResponse
forall x.
GetLoggingConfigurationResponse
-> Rep GetLoggingConfigurationResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep GetLoggingConfigurationResponse x
-> GetLoggingConfigurationResponse
$cfrom :: forall x.
GetLoggingConfigurationResponse
-> Rep GetLoggingConfigurationResponse x
Prelude.Generic)

-- |
-- Create a value of 'GetLoggingConfigurationResponse' 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:
--
-- 'loggingConfiguration', 'getLoggingConfigurationResponse_loggingConfiguration' - The LoggingConfiguration for the specified web ACL.
--
-- 'httpStatus', 'getLoggingConfigurationResponse_httpStatus' - The response's http status code.
newGetLoggingConfigurationResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  GetLoggingConfigurationResponse
newGetLoggingConfigurationResponse :: Int -> GetLoggingConfigurationResponse
newGetLoggingConfigurationResponse Int
pHttpStatus_ =
  GetLoggingConfigurationResponse'
    { $sel:loggingConfiguration:GetLoggingConfigurationResponse' :: Maybe LoggingConfiguration
loggingConfiguration =
        forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:GetLoggingConfigurationResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | The LoggingConfiguration for the specified web ACL.
getLoggingConfigurationResponse_loggingConfiguration :: Lens.Lens' GetLoggingConfigurationResponse (Prelude.Maybe LoggingConfiguration)
getLoggingConfigurationResponse_loggingConfiguration :: Lens' GetLoggingConfigurationResponse (Maybe LoggingConfiguration)
getLoggingConfigurationResponse_loggingConfiguration = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetLoggingConfigurationResponse' {Maybe LoggingConfiguration
loggingConfiguration :: Maybe LoggingConfiguration
$sel:loggingConfiguration:GetLoggingConfigurationResponse' :: GetLoggingConfigurationResponse -> Maybe LoggingConfiguration
loggingConfiguration} -> Maybe LoggingConfiguration
loggingConfiguration) (\s :: GetLoggingConfigurationResponse
s@GetLoggingConfigurationResponse' {} Maybe LoggingConfiguration
a -> GetLoggingConfigurationResponse
s {$sel:loggingConfiguration:GetLoggingConfigurationResponse' :: Maybe LoggingConfiguration
loggingConfiguration = Maybe LoggingConfiguration
a} :: GetLoggingConfigurationResponse)

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

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