{-# 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.IoT.GetV2LoggingOptions
-- 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 the fine grained logging options.
--
-- Requires permission to access the
-- <https://docs.aws.amazon.com/service-authorization/latest/reference/list_awsiot.html#awsiot-actions-as-permissions GetV2LoggingOptions>
-- action.
module Amazonka.IoT.GetV2LoggingOptions
  ( -- * Creating a Request
    GetV2LoggingOptions (..),
    newGetV2LoggingOptions,

    -- * Destructuring the Response
    GetV2LoggingOptionsResponse (..),
    newGetV2LoggingOptionsResponse,

    -- * Response Lenses
    getV2LoggingOptionsResponse_defaultLogLevel,
    getV2LoggingOptionsResponse_disableAllLogs,
    getV2LoggingOptionsResponse_roleArn,
    getV2LoggingOptionsResponse_httpStatus,
  )
where

import qualified Amazonka.Core as Core
import qualified Amazonka.Core.Lens.Internal as Lens
import qualified Amazonka.Data as Data
import Amazonka.IoT.Types
import qualified Amazonka.Prelude as Prelude
import qualified Amazonka.Request as Request
import qualified Amazonka.Response as Response

-- | /See:/ 'newGetV2LoggingOptions' smart constructor.
data GetV2LoggingOptions = GetV2LoggingOptions'
  {
  }
  deriving (GetV2LoggingOptions -> GetV2LoggingOptions -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetV2LoggingOptions -> GetV2LoggingOptions -> Bool
$c/= :: GetV2LoggingOptions -> GetV2LoggingOptions -> Bool
== :: GetV2LoggingOptions -> GetV2LoggingOptions -> Bool
$c== :: GetV2LoggingOptions -> GetV2LoggingOptions -> Bool
Prelude.Eq, ReadPrec [GetV2LoggingOptions]
ReadPrec GetV2LoggingOptions
Int -> ReadS GetV2LoggingOptions
ReadS [GetV2LoggingOptions]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GetV2LoggingOptions]
$creadListPrec :: ReadPrec [GetV2LoggingOptions]
readPrec :: ReadPrec GetV2LoggingOptions
$creadPrec :: ReadPrec GetV2LoggingOptions
readList :: ReadS [GetV2LoggingOptions]
$creadList :: ReadS [GetV2LoggingOptions]
readsPrec :: Int -> ReadS GetV2LoggingOptions
$creadsPrec :: Int -> ReadS GetV2LoggingOptions
Prelude.Read, Int -> GetV2LoggingOptions -> ShowS
[GetV2LoggingOptions] -> ShowS
GetV2LoggingOptions -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetV2LoggingOptions] -> ShowS
$cshowList :: [GetV2LoggingOptions] -> ShowS
show :: GetV2LoggingOptions -> String
$cshow :: GetV2LoggingOptions -> String
showsPrec :: Int -> GetV2LoggingOptions -> ShowS
$cshowsPrec :: Int -> GetV2LoggingOptions -> ShowS
Prelude.Show, forall x. Rep GetV2LoggingOptions x -> GetV2LoggingOptions
forall x. GetV2LoggingOptions -> Rep GetV2LoggingOptions x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep GetV2LoggingOptions x -> GetV2LoggingOptions
$cfrom :: forall x. GetV2LoggingOptions -> Rep GetV2LoggingOptions x
Prelude.Generic)

-- |
-- Create a value of 'GetV2LoggingOptions' 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.
newGetV2LoggingOptions ::
  GetV2LoggingOptions
newGetV2LoggingOptions :: GetV2LoggingOptions
newGetV2LoggingOptions = GetV2LoggingOptions
GetV2LoggingOptions'

instance Core.AWSRequest GetV2LoggingOptions where
  type
    AWSResponse GetV2LoggingOptions =
      GetV2LoggingOptionsResponse
  request :: (Service -> Service)
-> GetV2LoggingOptions -> Request GetV2LoggingOptions
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 GetV2LoggingOptions
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse GetV2LoggingOptions)))
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 LogLevel
-> Maybe Bool -> Maybe Text -> Int -> GetV2LoggingOptionsResponse
GetV2LoggingOptionsResponse'
            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
"defaultLogLevel")
            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
"disableAllLogs")
            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
"roleArn")
            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 GetV2LoggingOptions where
  hashWithSalt :: Int -> GetV2LoggingOptions -> Int
hashWithSalt Int
_salt GetV2LoggingOptions
_ =
    Int
_salt forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` ()

instance Prelude.NFData GetV2LoggingOptions where
  rnf :: GetV2LoggingOptions -> ()
rnf GetV2LoggingOptions
_ = ()

instance Data.ToHeaders GetV2LoggingOptions where
  toHeaders :: GetV2LoggingOptions -> ResponseHeaders
toHeaders = forall a b. a -> b -> a
Prelude.const forall a. Monoid a => a
Prelude.mempty

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

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

-- | /See:/ 'newGetV2LoggingOptionsResponse' smart constructor.
data GetV2LoggingOptionsResponse = GetV2LoggingOptionsResponse'
  { -- | The default log level.
    GetV2LoggingOptionsResponse -> Maybe LogLevel
defaultLogLevel :: Prelude.Maybe LogLevel,
    -- | Disables all logs.
    GetV2LoggingOptionsResponse -> Maybe Bool
disableAllLogs :: Prelude.Maybe Prelude.Bool,
    -- | The IAM role ARN IoT uses to write to your CloudWatch logs.
    GetV2LoggingOptionsResponse -> Maybe Text
roleArn :: Prelude.Maybe Prelude.Text,
    -- | The response's http status code.
    GetV2LoggingOptionsResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (GetV2LoggingOptionsResponse -> GetV2LoggingOptionsResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetV2LoggingOptionsResponse -> GetV2LoggingOptionsResponse -> Bool
$c/= :: GetV2LoggingOptionsResponse -> GetV2LoggingOptionsResponse -> Bool
== :: GetV2LoggingOptionsResponse -> GetV2LoggingOptionsResponse -> Bool
$c== :: GetV2LoggingOptionsResponse -> GetV2LoggingOptionsResponse -> Bool
Prelude.Eq, ReadPrec [GetV2LoggingOptionsResponse]
ReadPrec GetV2LoggingOptionsResponse
Int -> ReadS GetV2LoggingOptionsResponse
ReadS [GetV2LoggingOptionsResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GetV2LoggingOptionsResponse]
$creadListPrec :: ReadPrec [GetV2LoggingOptionsResponse]
readPrec :: ReadPrec GetV2LoggingOptionsResponse
$creadPrec :: ReadPrec GetV2LoggingOptionsResponse
readList :: ReadS [GetV2LoggingOptionsResponse]
$creadList :: ReadS [GetV2LoggingOptionsResponse]
readsPrec :: Int -> ReadS GetV2LoggingOptionsResponse
$creadsPrec :: Int -> ReadS GetV2LoggingOptionsResponse
Prelude.Read, Int -> GetV2LoggingOptionsResponse -> ShowS
[GetV2LoggingOptionsResponse] -> ShowS
GetV2LoggingOptionsResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetV2LoggingOptionsResponse] -> ShowS
$cshowList :: [GetV2LoggingOptionsResponse] -> ShowS
show :: GetV2LoggingOptionsResponse -> String
$cshow :: GetV2LoggingOptionsResponse -> String
showsPrec :: Int -> GetV2LoggingOptionsResponse -> ShowS
$cshowsPrec :: Int -> GetV2LoggingOptionsResponse -> ShowS
Prelude.Show, forall x.
Rep GetV2LoggingOptionsResponse x -> GetV2LoggingOptionsResponse
forall x.
GetV2LoggingOptionsResponse -> Rep GetV2LoggingOptionsResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep GetV2LoggingOptionsResponse x -> GetV2LoggingOptionsResponse
$cfrom :: forall x.
GetV2LoggingOptionsResponse -> Rep GetV2LoggingOptionsResponse x
Prelude.Generic)

-- |
-- Create a value of 'GetV2LoggingOptionsResponse' 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:
--
-- 'defaultLogLevel', 'getV2LoggingOptionsResponse_defaultLogLevel' - The default log level.
--
-- 'disableAllLogs', 'getV2LoggingOptionsResponse_disableAllLogs' - Disables all logs.
--
-- 'roleArn', 'getV2LoggingOptionsResponse_roleArn' - The IAM role ARN IoT uses to write to your CloudWatch logs.
--
-- 'httpStatus', 'getV2LoggingOptionsResponse_httpStatus' - The response's http status code.
newGetV2LoggingOptionsResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  GetV2LoggingOptionsResponse
newGetV2LoggingOptionsResponse :: Int -> GetV2LoggingOptionsResponse
newGetV2LoggingOptionsResponse Int
pHttpStatus_ =
  GetV2LoggingOptionsResponse'
    { $sel:defaultLogLevel:GetV2LoggingOptionsResponse' :: Maybe LogLevel
defaultLogLevel =
        forall a. Maybe a
Prelude.Nothing,
      $sel:disableAllLogs:GetV2LoggingOptionsResponse' :: Maybe Bool
disableAllLogs = forall a. Maybe a
Prelude.Nothing,
      $sel:roleArn:GetV2LoggingOptionsResponse' :: Maybe Text
roleArn = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:GetV2LoggingOptionsResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | The default log level.
getV2LoggingOptionsResponse_defaultLogLevel :: Lens.Lens' GetV2LoggingOptionsResponse (Prelude.Maybe LogLevel)
getV2LoggingOptionsResponse_defaultLogLevel :: Lens' GetV2LoggingOptionsResponse (Maybe LogLevel)
getV2LoggingOptionsResponse_defaultLogLevel = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetV2LoggingOptionsResponse' {Maybe LogLevel
defaultLogLevel :: Maybe LogLevel
$sel:defaultLogLevel:GetV2LoggingOptionsResponse' :: GetV2LoggingOptionsResponse -> Maybe LogLevel
defaultLogLevel} -> Maybe LogLevel
defaultLogLevel) (\s :: GetV2LoggingOptionsResponse
s@GetV2LoggingOptionsResponse' {} Maybe LogLevel
a -> GetV2LoggingOptionsResponse
s {$sel:defaultLogLevel:GetV2LoggingOptionsResponse' :: Maybe LogLevel
defaultLogLevel = Maybe LogLevel
a} :: GetV2LoggingOptionsResponse)

-- | Disables all logs.
getV2LoggingOptionsResponse_disableAllLogs :: Lens.Lens' GetV2LoggingOptionsResponse (Prelude.Maybe Prelude.Bool)
getV2LoggingOptionsResponse_disableAllLogs :: Lens' GetV2LoggingOptionsResponse (Maybe Bool)
getV2LoggingOptionsResponse_disableAllLogs = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetV2LoggingOptionsResponse' {Maybe Bool
disableAllLogs :: Maybe Bool
$sel:disableAllLogs:GetV2LoggingOptionsResponse' :: GetV2LoggingOptionsResponse -> Maybe Bool
disableAllLogs} -> Maybe Bool
disableAllLogs) (\s :: GetV2LoggingOptionsResponse
s@GetV2LoggingOptionsResponse' {} Maybe Bool
a -> GetV2LoggingOptionsResponse
s {$sel:disableAllLogs:GetV2LoggingOptionsResponse' :: Maybe Bool
disableAllLogs = Maybe Bool
a} :: GetV2LoggingOptionsResponse)

-- | The IAM role ARN IoT uses to write to your CloudWatch logs.
getV2LoggingOptionsResponse_roleArn :: Lens.Lens' GetV2LoggingOptionsResponse (Prelude.Maybe Prelude.Text)
getV2LoggingOptionsResponse_roleArn :: Lens' GetV2LoggingOptionsResponse (Maybe Text)
getV2LoggingOptionsResponse_roleArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetV2LoggingOptionsResponse' {Maybe Text
roleArn :: Maybe Text
$sel:roleArn:GetV2LoggingOptionsResponse' :: GetV2LoggingOptionsResponse -> Maybe Text
roleArn} -> Maybe Text
roleArn) (\s :: GetV2LoggingOptionsResponse
s@GetV2LoggingOptionsResponse' {} Maybe Text
a -> GetV2LoggingOptionsResponse
s {$sel:roleArn:GetV2LoggingOptionsResponse' :: Maybe Text
roleArn = Maybe Text
a} :: GetV2LoggingOptionsResponse)

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

instance Prelude.NFData GetV2LoggingOptionsResponse where
  rnf :: GetV2LoggingOptionsResponse -> ()
rnf GetV2LoggingOptionsResponse' {Int
Maybe Bool
Maybe Text
Maybe LogLevel
httpStatus :: Int
roleArn :: Maybe Text
disableAllLogs :: Maybe Bool
defaultLogLevel :: Maybe LogLevel
$sel:httpStatus:GetV2LoggingOptionsResponse' :: GetV2LoggingOptionsResponse -> Int
$sel:roleArn:GetV2LoggingOptionsResponse' :: GetV2LoggingOptionsResponse -> Maybe Text
$sel:disableAllLogs:GetV2LoggingOptionsResponse' :: GetV2LoggingOptionsResponse -> Maybe Bool
$sel:defaultLogLevel:GetV2LoggingOptionsResponse' :: GetV2LoggingOptionsResponse -> Maybe LogLevel
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe LogLevel
defaultLogLevel
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Bool
disableAllLogs
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
roleArn
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus