{-# 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.SetV2LoggingOptions
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Sets the logging options for the V2 logging service.
--
-- Requires permission to access the
-- <https://docs.aws.amazon.com/service-authorization/latest/reference/list_awsiot.html#awsiot-actions-as-permissions SetV2LoggingOptions>
-- action.
module Amazonka.IoT.SetV2LoggingOptions
  ( -- * Creating a Request
    SetV2LoggingOptions (..),
    newSetV2LoggingOptions,

    -- * Request Lenses
    setV2LoggingOptions_defaultLogLevel,
    setV2LoggingOptions_disableAllLogs,
    setV2LoggingOptions_roleArn,

    -- * Destructuring the Response
    SetV2LoggingOptionsResponse (..),
    newSetV2LoggingOptionsResponse,
  )
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:/ 'newSetV2LoggingOptions' smart constructor.
data SetV2LoggingOptions = SetV2LoggingOptions'
  { -- | The default logging level.
    SetV2LoggingOptions -> Maybe LogLevel
defaultLogLevel :: Prelude.Maybe LogLevel,
    -- | If true all logs are disabled. The default is false.
    SetV2LoggingOptions -> Maybe Bool
disableAllLogs :: Prelude.Maybe Prelude.Bool,
    -- | The ARN of the role that allows IoT to write to Cloudwatch logs.
    SetV2LoggingOptions -> Maybe Text
roleArn :: Prelude.Maybe Prelude.Text
  }
  deriving (SetV2LoggingOptions -> SetV2LoggingOptions -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SetV2LoggingOptions -> SetV2LoggingOptions -> Bool
$c/= :: SetV2LoggingOptions -> SetV2LoggingOptions -> Bool
== :: SetV2LoggingOptions -> SetV2LoggingOptions -> Bool
$c== :: SetV2LoggingOptions -> SetV2LoggingOptions -> Bool
Prelude.Eq, ReadPrec [SetV2LoggingOptions]
ReadPrec SetV2LoggingOptions
Int -> ReadS SetV2LoggingOptions
ReadS [SetV2LoggingOptions]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [SetV2LoggingOptions]
$creadListPrec :: ReadPrec [SetV2LoggingOptions]
readPrec :: ReadPrec SetV2LoggingOptions
$creadPrec :: ReadPrec SetV2LoggingOptions
readList :: ReadS [SetV2LoggingOptions]
$creadList :: ReadS [SetV2LoggingOptions]
readsPrec :: Int -> ReadS SetV2LoggingOptions
$creadsPrec :: Int -> ReadS SetV2LoggingOptions
Prelude.Read, Int -> SetV2LoggingOptions -> ShowS
[SetV2LoggingOptions] -> ShowS
SetV2LoggingOptions -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SetV2LoggingOptions] -> ShowS
$cshowList :: [SetV2LoggingOptions] -> ShowS
show :: SetV2LoggingOptions -> String
$cshow :: SetV2LoggingOptions -> String
showsPrec :: Int -> SetV2LoggingOptions -> ShowS
$cshowsPrec :: Int -> SetV2LoggingOptions -> ShowS
Prelude.Show, forall x. Rep SetV2LoggingOptions x -> SetV2LoggingOptions
forall x. SetV2LoggingOptions -> Rep SetV2LoggingOptions x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep SetV2LoggingOptions x -> SetV2LoggingOptions
$cfrom :: forall x. SetV2LoggingOptions -> Rep SetV2LoggingOptions x
Prelude.Generic)

-- |
-- Create a value of 'SetV2LoggingOptions' 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', 'setV2LoggingOptions_defaultLogLevel' - The default logging level.
--
-- 'disableAllLogs', 'setV2LoggingOptions_disableAllLogs' - If true all logs are disabled. The default is false.
--
-- 'roleArn', 'setV2LoggingOptions_roleArn' - The ARN of the role that allows IoT to write to Cloudwatch logs.
newSetV2LoggingOptions ::
  SetV2LoggingOptions
newSetV2LoggingOptions :: SetV2LoggingOptions
newSetV2LoggingOptions =
  SetV2LoggingOptions'
    { $sel:defaultLogLevel:SetV2LoggingOptions' :: Maybe LogLevel
defaultLogLevel =
        forall a. Maybe a
Prelude.Nothing,
      $sel:disableAllLogs:SetV2LoggingOptions' :: Maybe Bool
disableAllLogs = forall a. Maybe a
Prelude.Nothing,
      $sel:roleArn:SetV2LoggingOptions' :: Maybe Text
roleArn = forall a. Maybe a
Prelude.Nothing
    }

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

-- | If true all logs are disabled. The default is false.
setV2LoggingOptions_disableAllLogs :: Lens.Lens' SetV2LoggingOptions (Prelude.Maybe Prelude.Bool)
setV2LoggingOptions_disableAllLogs :: Lens' SetV2LoggingOptions (Maybe Bool)
setV2LoggingOptions_disableAllLogs = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\SetV2LoggingOptions' {Maybe Bool
disableAllLogs :: Maybe Bool
$sel:disableAllLogs:SetV2LoggingOptions' :: SetV2LoggingOptions -> Maybe Bool
disableAllLogs} -> Maybe Bool
disableAllLogs) (\s :: SetV2LoggingOptions
s@SetV2LoggingOptions' {} Maybe Bool
a -> SetV2LoggingOptions
s {$sel:disableAllLogs:SetV2LoggingOptions' :: Maybe Bool
disableAllLogs = Maybe Bool
a} :: SetV2LoggingOptions)

-- | The ARN of the role that allows IoT to write to Cloudwatch logs.
setV2LoggingOptions_roleArn :: Lens.Lens' SetV2LoggingOptions (Prelude.Maybe Prelude.Text)
setV2LoggingOptions_roleArn :: Lens' SetV2LoggingOptions (Maybe Text)
setV2LoggingOptions_roleArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\SetV2LoggingOptions' {Maybe Text
roleArn :: Maybe Text
$sel:roleArn:SetV2LoggingOptions' :: SetV2LoggingOptions -> Maybe Text
roleArn} -> Maybe Text
roleArn) (\s :: SetV2LoggingOptions
s@SetV2LoggingOptions' {} Maybe Text
a -> SetV2LoggingOptions
s {$sel:roleArn:SetV2LoggingOptions' :: Maybe Text
roleArn = Maybe Text
a} :: SetV2LoggingOptions)

instance Core.AWSRequest SetV2LoggingOptions where
  type
    AWSResponse SetV2LoggingOptions =
      SetV2LoggingOptionsResponse
  request :: (Service -> Service)
-> SetV2LoggingOptions -> Request SetV2LoggingOptions
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 SetV2LoggingOptions
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse SetV2LoggingOptions)))
response =
    forall (m :: * -> *) a.
MonadResource m =>
AWSResponse a
-> (ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy a
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse a)))
Response.receiveNull SetV2LoggingOptionsResponse
SetV2LoggingOptionsResponse'

instance Prelude.Hashable SetV2LoggingOptions where
  hashWithSalt :: Int -> SetV2LoggingOptions -> Int
hashWithSalt Int
_salt SetV2LoggingOptions' {Maybe Bool
Maybe Text
Maybe LogLevel
roleArn :: Maybe Text
disableAllLogs :: Maybe Bool
defaultLogLevel :: Maybe LogLevel
$sel:roleArn:SetV2LoggingOptions' :: SetV2LoggingOptions -> Maybe Text
$sel:disableAllLogs:SetV2LoggingOptions' :: SetV2LoggingOptions -> Maybe Bool
$sel:defaultLogLevel:SetV2LoggingOptions' :: SetV2LoggingOptions -> Maybe LogLevel
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe LogLevel
defaultLogLevel
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Bool
disableAllLogs
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
roleArn

instance Prelude.NFData SetV2LoggingOptions where
  rnf :: SetV2LoggingOptions -> ()
rnf SetV2LoggingOptions' {Maybe Bool
Maybe Text
Maybe LogLevel
roleArn :: Maybe Text
disableAllLogs :: Maybe Bool
defaultLogLevel :: Maybe LogLevel
$sel:roleArn:SetV2LoggingOptions' :: SetV2LoggingOptions -> Maybe Text
$sel:disableAllLogs:SetV2LoggingOptions' :: SetV2LoggingOptions -> Maybe Bool
$sel:defaultLogLevel:SetV2LoggingOptions' :: SetV2LoggingOptions -> 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

instance Data.ToHeaders SetV2LoggingOptions where
  toHeaders :: SetV2LoggingOptions -> [Header]
toHeaders = forall a b. a -> b -> a
Prelude.const forall a. Monoid a => a
Prelude.mempty

instance Data.ToJSON SetV2LoggingOptions where
  toJSON :: SetV2LoggingOptions -> Value
toJSON SetV2LoggingOptions' {Maybe Bool
Maybe Text
Maybe LogLevel
roleArn :: Maybe Text
disableAllLogs :: Maybe Bool
defaultLogLevel :: Maybe LogLevel
$sel:roleArn:SetV2LoggingOptions' :: SetV2LoggingOptions -> Maybe Text
$sel:disableAllLogs:SetV2LoggingOptions' :: SetV2LoggingOptions -> Maybe Bool
$sel:defaultLogLevel:SetV2LoggingOptions' :: SetV2LoggingOptions -> Maybe LogLevel
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"defaultLogLevel" 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 LogLevel
defaultLogLevel,
            (Key
"disableAllLogs" 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 Bool
disableAllLogs,
            (Key
"roleArn" 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
roleArn
          ]
      )

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

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

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

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

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