{-# 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.WorkSpacesWeb.UpdateUserAccessLoggingSettings
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Updates the user access logging settings.
module Amazonka.WorkSpacesWeb.UpdateUserAccessLoggingSettings
  ( -- * Creating a Request
    UpdateUserAccessLoggingSettings (..),
    newUpdateUserAccessLoggingSettings,

    -- * Request Lenses
    updateUserAccessLoggingSettings_clientToken,
    updateUserAccessLoggingSettings_kinesisStreamArn,
    updateUserAccessLoggingSettings_userAccessLoggingSettingsArn,

    -- * Destructuring the Response
    UpdateUserAccessLoggingSettingsResponse (..),
    newUpdateUserAccessLoggingSettingsResponse,

    -- * Response Lenses
    updateUserAccessLoggingSettingsResponse_httpStatus,
    updateUserAccessLoggingSettingsResponse_userAccessLoggingSettings,
  )
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.WorkSpacesWeb.Types

-- | /See:/ 'newUpdateUserAccessLoggingSettings' smart constructor.
data UpdateUserAccessLoggingSettings = UpdateUserAccessLoggingSettings'
  { -- | A unique, case-sensitive identifier that you provide to ensure the
    -- idempotency of the request. Idempotency ensures that an API request
    -- completes only once. With an idempotent request, if the original request
    -- completes successfully, subsequent retries with the same client token
    -- return the result from the original successful request.
    --
    -- If you do not specify a client token, one is automatically generated by
    -- the AWS SDK.
    UpdateUserAccessLoggingSettings -> Maybe Text
clientToken :: Prelude.Maybe Prelude.Text,
    -- | The ARN of the Kinesis stream.
    UpdateUserAccessLoggingSettings -> Maybe Text
kinesisStreamArn :: Prelude.Maybe Prelude.Text,
    -- | The ARN of the user access logging settings.
    UpdateUserAccessLoggingSettings -> Text
userAccessLoggingSettingsArn :: Prelude.Text
  }
  deriving (UpdateUserAccessLoggingSettings
-> UpdateUserAccessLoggingSettings -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UpdateUserAccessLoggingSettings
-> UpdateUserAccessLoggingSettings -> Bool
$c/= :: UpdateUserAccessLoggingSettings
-> UpdateUserAccessLoggingSettings -> Bool
== :: UpdateUserAccessLoggingSettings
-> UpdateUserAccessLoggingSettings -> Bool
$c== :: UpdateUserAccessLoggingSettings
-> UpdateUserAccessLoggingSettings -> Bool
Prelude.Eq, ReadPrec [UpdateUserAccessLoggingSettings]
ReadPrec UpdateUserAccessLoggingSettings
Int -> ReadS UpdateUserAccessLoggingSettings
ReadS [UpdateUserAccessLoggingSettings]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [UpdateUserAccessLoggingSettings]
$creadListPrec :: ReadPrec [UpdateUserAccessLoggingSettings]
readPrec :: ReadPrec UpdateUserAccessLoggingSettings
$creadPrec :: ReadPrec UpdateUserAccessLoggingSettings
readList :: ReadS [UpdateUserAccessLoggingSettings]
$creadList :: ReadS [UpdateUserAccessLoggingSettings]
readsPrec :: Int -> ReadS UpdateUserAccessLoggingSettings
$creadsPrec :: Int -> ReadS UpdateUserAccessLoggingSettings
Prelude.Read, Int -> UpdateUserAccessLoggingSettings -> ShowS
[UpdateUserAccessLoggingSettings] -> ShowS
UpdateUserAccessLoggingSettings -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UpdateUserAccessLoggingSettings] -> ShowS
$cshowList :: [UpdateUserAccessLoggingSettings] -> ShowS
show :: UpdateUserAccessLoggingSettings -> String
$cshow :: UpdateUserAccessLoggingSettings -> String
showsPrec :: Int -> UpdateUserAccessLoggingSettings -> ShowS
$cshowsPrec :: Int -> UpdateUserAccessLoggingSettings -> ShowS
Prelude.Show, forall x.
Rep UpdateUserAccessLoggingSettings x
-> UpdateUserAccessLoggingSettings
forall x.
UpdateUserAccessLoggingSettings
-> Rep UpdateUserAccessLoggingSettings x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep UpdateUserAccessLoggingSettings x
-> UpdateUserAccessLoggingSettings
$cfrom :: forall x.
UpdateUserAccessLoggingSettings
-> Rep UpdateUserAccessLoggingSettings x
Prelude.Generic)

-- |
-- Create a value of 'UpdateUserAccessLoggingSettings' 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:
--
-- 'clientToken', 'updateUserAccessLoggingSettings_clientToken' - A unique, case-sensitive identifier that you provide to ensure the
-- idempotency of the request. Idempotency ensures that an API request
-- completes only once. With an idempotent request, if the original request
-- completes successfully, subsequent retries with the same client token
-- return the result from the original successful request.
--
-- If you do not specify a client token, one is automatically generated by
-- the AWS SDK.
--
-- 'kinesisStreamArn', 'updateUserAccessLoggingSettings_kinesisStreamArn' - The ARN of the Kinesis stream.
--
-- 'userAccessLoggingSettingsArn', 'updateUserAccessLoggingSettings_userAccessLoggingSettingsArn' - The ARN of the user access logging settings.
newUpdateUserAccessLoggingSettings ::
  -- | 'userAccessLoggingSettingsArn'
  Prelude.Text ->
  UpdateUserAccessLoggingSettings
newUpdateUserAccessLoggingSettings :: Text -> UpdateUserAccessLoggingSettings
newUpdateUserAccessLoggingSettings
  Text
pUserAccessLoggingSettingsArn_ =
    UpdateUserAccessLoggingSettings'
      { $sel:clientToken:UpdateUserAccessLoggingSettings' :: Maybe Text
clientToken =
          forall a. Maybe a
Prelude.Nothing,
        $sel:kinesisStreamArn:UpdateUserAccessLoggingSettings' :: Maybe Text
kinesisStreamArn = forall a. Maybe a
Prelude.Nothing,
        $sel:userAccessLoggingSettingsArn:UpdateUserAccessLoggingSettings' :: Text
userAccessLoggingSettingsArn =
          Text
pUserAccessLoggingSettingsArn_
      }

-- | A unique, case-sensitive identifier that you provide to ensure the
-- idempotency of the request. Idempotency ensures that an API request
-- completes only once. With an idempotent request, if the original request
-- completes successfully, subsequent retries with the same client token
-- return the result from the original successful request.
--
-- If you do not specify a client token, one is automatically generated by
-- the AWS SDK.
updateUserAccessLoggingSettings_clientToken :: Lens.Lens' UpdateUserAccessLoggingSettings (Prelude.Maybe Prelude.Text)
updateUserAccessLoggingSettings_clientToken :: Lens' UpdateUserAccessLoggingSettings (Maybe Text)
updateUserAccessLoggingSettings_clientToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateUserAccessLoggingSettings' {Maybe Text
clientToken :: Maybe Text
$sel:clientToken:UpdateUserAccessLoggingSettings' :: UpdateUserAccessLoggingSettings -> Maybe Text
clientToken} -> Maybe Text
clientToken) (\s :: UpdateUserAccessLoggingSettings
s@UpdateUserAccessLoggingSettings' {} Maybe Text
a -> UpdateUserAccessLoggingSettings
s {$sel:clientToken:UpdateUserAccessLoggingSettings' :: Maybe Text
clientToken = Maybe Text
a} :: UpdateUserAccessLoggingSettings)

-- | The ARN of the Kinesis stream.
updateUserAccessLoggingSettings_kinesisStreamArn :: Lens.Lens' UpdateUserAccessLoggingSettings (Prelude.Maybe Prelude.Text)
updateUserAccessLoggingSettings_kinesisStreamArn :: Lens' UpdateUserAccessLoggingSettings (Maybe Text)
updateUserAccessLoggingSettings_kinesisStreamArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateUserAccessLoggingSettings' {Maybe Text
kinesisStreamArn :: Maybe Text
$sel:kinesisStreamArn:UpdateUserAccessLoggingSettings' :: UpdateUserAccessLoggingSettings -> Maybe Text
kinesisStreamArn} -> Maybe Text
kinesisStreamArn) (\s :: UpdateUserAccessLoggingSettings
s@UpdateUserAccessLoggingSettings' {} Maybe Text
a -> UpdateUserAccessLoggingSettings
s {$sel:kinesisStreamArn:UpdateUserAccessLoggingSettings' :: Maybe Text
kinesisStreamArn = Maybe Text
a} :: UpdateUserAccessLoggingSettings)

-- | The ARN of the user access logging settings.
updateUserAccessLoggingSettings_userAccessLoggingSettingsArn :: Lens.Lens' UpdateUserAccessLoggingSettings Prelude.Text
updateUserAccessLoggingSettings_userAccessLoggingSettingsArn :: Lens' UpdateUserAccessLoggingSettings Text
updateUserAccessLoggingSettings_userAccessLoggingSettingsArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateUserAccessLoggingSettings' {Text
userAccessLoggingSettingsArn :: Text
$sel:userAccessLoggingSettingsArn:UpdateUserAccessLoggingSettings' :: UpdateUserAccessLoggingSettings -> Text
userAccessLoggingSettingsArn} -> Text
userAccessLoggingSettingsArn) (\s :: UpdateUserAccessLoggingSettings
s@UpdateUserAccessLoggingSettings' {} Text
a -> UpdateUserAccessLoggingSettings
s {$sel:userAccessLoggingSettingsArn:UpdateUserAccessLoggingSettings' :: Text
userAccessLoggingSettingsArn = Text
a} :: UpdateUserAccessLoggingSettings)

instance
  Core.AWSRequest
    UpdateUserAccessLoggingSettings
  where
  type
    AWSResponse UpdateUserAccessLoggingSettings =
      UpdateUserAccessLoggingSettingsResponse
  request :: (Service -> Service)
-> UpdateUserAccessLoggingSettings
-> Request UpdateUserAccessLoggingSettings
request Service -> Service
overrides =
    forall a. (ToRequest a, ToJSON a) => Service -> a -> Request a
Request.patchJSON (Service -> Service
overrides Service
defaultService)
  response :: forall (m :: * -> *).
MonadResource m =>
(ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy UpdateUserAccessLoggingSettings
-> ClientResponse ClientBody
-> m (Either
        Error
        (ClientResponse (AWSResponse UpdateUserAccessLoggingSettings)))
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 ->
          Int
-> UserAccessLoggingSettings
-> UpdateUserAccessLoggingSettingsResponse
UpdateUserAccessLoggingSettingsResponse'
            forall (f :: * -> *) a b. Functor 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))
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String a
Data..:> Key
"userAccessLoggingSettings")
      )

instance
  Prelude.Hashable
    UpdateUserAccessLoggingSettings
  where
  hashWithSalt :: Int -> UpdateUserAccessLoggingSettings -> Int
hashWithSalt
    Int
_salt
    UpdateUserAccessLoggingSettings' {Maybe Text
Text
userAccessLoggingSettingsArn :: Text
kinesisStreamArn :: Maybe Text
clientToken :: Maybe Text
$sel:userAccessLoggingSettingsArn:UpdateUserAccessLoggingSettings' :: UpdateUserAccessLoggingSettings -> Text
$sel:kinesisStreamArn:UpdateUserAccessLoggingSettings' :: UpdateUserAccessLoggingSettings -> Maybe Text
$sel:clientToken:UpdateUserAccessLoggingSettings' :: UpdateUserAccessLoggingSettings -> Maybe Text
..} =
      Int
_salt
        forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
clientToken
        forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
kinesisStreamArn
        forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
userAccessLoggingSettingsArn

instance
  Prelude.NFData
    UpdateUserAccessLoggingSettings
  where
  rnf :: UpdateUserAccessLoggingSettings -> ()
rnf UpdateUserAccessLoggingSettings' {Maybe Text
Text
userAccessLoggingSettingsArn :: Text
kinesisStreamArn :: Maybe Text
clientToken :: Maybe Text
$sel:userAccessLoggingSettingsArn:UpdateUserAccessLoggingSettings' :: UpdateUserAccessLoggingSettings -> Text
$sel:kinesisStreamArn:UpdateUserAccessLoggingSettings' :: UpdateUserAccessLoggingSettings -> Maybe Text
$sel:clientToken:UpdateUserAccessLoggingSettings' :: UpdateUserAccessLoggingSettings -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
clientToken
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
kinesisStreamArn
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
userAccessLoggingSettingsArn

instance
  Data.ToHeaders
    UpdateUserAccessLoggingSettings
  where
  toHeaders :: UpdateUserAccessLoggingSettings -> ResponseHeaders
toHeaders =
    forall a b. a -> b -> a
Prelude.const
      ( forall a. Monoid a => [a] -> a
Prelude.mconcat
          [ HeaderName
"Content-Type"
              forall a. ToHeader a => HeaderName -> a -> ResponseHeaders
Data.=# ( ByteString
"application/x-amz-json-1.1" ::
                          Prelude.ByteString
                      )
          ]
      )

instance Data.ToJSON UpdateUserAccessLoggingSettings where
  toJSON :: UpdateUserAccessLoggingSettings -> Value
toJSON UpdateUserAccessLoggingSettings' {Maybe Text
Text
userAccessLoggingSettingsArn :: Text
kinesisStreamArn :: Maybe Text
clientToken :: Maybe Text
$sel:userAccessLoggingSettingsArn:UpdateUserAccessLoggingSettings' :: UpdateUserAccessLoggingSettings -> Text
$sel:kinesisStreamArn:UpdateUserAccessLoggingSettings' :: UpdateUserAccessLoggingSettings -> Maybe Text
$sel:clientToken:UpdateUserAccessLoggingSettings' :: UpdateUserAccessLoggingSettings -> Maybe Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"clientToken" 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
clientToken,
            (Key
"kinesisStreamArn" 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
kinesisStreamArn
          ]
      )

instance Data.ToPath UpdateUserAccessLoggingSettings where
  toPath :: UpdateUserAccessLoggingSettings -> ByteString
toPath UpdateUserAccessLoggingSettings' {Maybe Text
Text
userAccessLoggingSettingsArn :: Text
kinesisStreamArn :: Maybe Text
clientToken :: Maybe Text
$sel:userAccessLoggingSettingsArn:UpdateUserAccessLoggingSettings' :: UpdateUserAccessLoggingSettings -> Text
$sel:kinesisStreamArn:UpdateUserAccessLoggingSettings' :: UpdateUserAccessLoggingSettings -> Maybe Text
$sel:clientToken:UpdateUserAccessLoggingSettings' :: UpdateUserAccessLoggingSettings -> Maybe Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"/userAccessLoggingSettings/",
        forall a. ToByteString a => a -> ByteString
Data.toBS Text
userAccessLoggingSettingsArn
      ]

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

-- | /See:/ 'newUpdateUserAccessLoggingSettingsResponse' smart constructor.
data UpdateUserAccessLoggingSettingsResponse = UpdateUserAccessLoggingSettingsResponse'
  { -- | The response's http status code.
    UpdateUserAccessLoggingSettingsResponse -> Int
httpStatus :: Prelude.Int,
    -- | The user access logging settings.
    UpdateUserAccessLoggingSettingsResponse
-> UserAccessLoggingSettings
userAccessLoggingSettings :: UserAccessLoggingSettings
  }
  deriving (UpdateUserAccessLoggingSettingsResponse
-> UpdateUserAccessLoggingSettingsResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UpdateUserAccessLoggingSettingsResponse
-> UpdateUserAccessLoggingSettingsResponse -> Bool
$c/= :: UpdateUserAccessLoggingSettingsResponse
-> UpdateUserAccessLoggingSettingsResponse -> Bool
== :: UpdateUserAccessLoggingSettingsResponse
-> UpdateUserAccessLoggingSettingsResponse -> Bool
$c== :: UpdateUserAccessLoggingSettingsResponse
-> UpdateUserAccessLoggingSettingsResponse -> Bool
Prelude.Eq, ReadPrec [UpdateUserAccessLoggingSettingsResponse]
ReadPrec UpdateUserAccessLoggingSettingsResponse
Int -> ReadS UpdateUserAccessLoggingSettingsResponse
ReadS [UpdateUserAccessLoggingSettingsResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [UpdateUserAccessLoggingSettingsResponse]
$creadListPrec :: ReadPrec [UpdateUserAccessLoggingSettingsResponse]
readPrec :: ReadPrec UpdateUserAccessLoggingSettingsResponse
$creadPrec :: ReadPrec UpdateUserAccessLoggingSettingsResponse
readList :: ReadS [UpdateUserAccessLoggingSettingsResponse]
$creadList :: ReadS [UpdateUserAccessLoggingSettingsResponse]
readsPrec :: Int -> ReadS UpdateUserAccessLoggingSettingsResponse
$creadsPrec :: Int -> ReadS UpdateUserAccessLoggingSettingsResponse
Prelude.Read, Int -> UpdateUserAccessLoggingSettingsResponse -> ShowS
[UpdateUserAccessLoggingSettingsResponse] -> ShowS
UpdateUserAccessLoggingSettingsResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UpdateUserAccessLoggingSettingsResponse] -> ShowS
$cshowList :: [UpdateUserAccessLoggingSettingsResponse] -> ShowS
show :: UpdateUserAccessLoggingSettingsResponse -> String
$cshow :: UpdateUserAccessLoggingSettingsResponse -> String
showsPrec :: Int -> UpdateUserAccessLoggingSettingsResponse -> ShowS
$cshowsPrec :: Int -> UpdateUserAccessLoggingSettingsResponse -> ShowS
Prelude.Show, forall x.
Rep UpdateUserAccessLoggingSettingsResponse x
-> UpdateUserAccessLoggingSettingsResponse
forall x.
UpdateUserAccessLoggingSettingsResponse
-> Rep UpdateUserAccessLoggingSettingsResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep UpdateUserAccessLoggingSettingsResponse x
-> UpdateUserAccessLoggingSettingsResponse
$cfrom :: forall x.
UpdateUserAccessLoggingSettingsResponse
-> Rep UpdateUserAccessLoggingSettingsResponse x
Prelude.Generic)

-- |
-- Create a value of 'UpdateUserAccessLoggingSettingsResponse' 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:
--
-- 'httpStatus', 'updateUserAccessLoggingSettingsResponse_httpStatus' - The response's http status code.
--
-- 'userAccessLoggingSettings', 'updateUserAccessLoggingSettingsResponse_userAccessLoggingSettings' - The user access logging settings.
newUpdateUserAccessLoggingSettingsResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  -- | 'userAccessLoggingSettings'
  UserAccessLoggingSettings ->
  UpdateUserAccessLoggingSettingsResponse
newUpdateUserAccessLoggingSettingsResponse :: Int
-> UserAccessLoggingSettings
-> UpdateUserAccessLoggingSettingsResponse
newUpdateUserAccessLoggingSettingsResponse
  Int
pHttpStatus_
  UserAccessLoggingSettings
pUserAccessLoggingSettings_ =
    UpdateUserAccessLoggingSettingsResponse'
      { $sel:httpStatus:UpdateUserAccessLoggingSettingsResponse' :: Int
httpStatus =
          Int
pHttpStatus_,
        $sel:userAccessLoggingSettings:UpdateUserAccessLoggingSettingsResponse' :: UserAccessLoggingSettings
userAccessLoggingSettings =
          UserAccessLoggingSettings
pUserAccessLoggingSettings_
      }

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

-- | The user access logging settings.
updateUserAccessLoggingSettingsResponse_userAccessLoggingSettings :: Lens.Lens' UpdateUserAccessLoggingSettingsResponse UserAccessLoggingSettings
updateUserAccessLoggingSettingsResponse_userAccessLoggingSettings :: Lens'
  UpdateUserAccessLoggingSettingsResponse UserAccessLoggingSettings
updateUserAccessLoggingSettingsResponse_userAccessLoggingSettings = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateUserAccessLoggingSettingsResponse' {UserAccessLoggingSettings
userAccessLoggingSettings :: UserAccessLoggingSettings
$sel:userAccessLoggingSettings:UpdateUserAccessLoggingSettingsResponse' :: UpdateUserAccessLoggingSettingsResponse
-> UserAccessLoggingSettings
userAccessLoggingSettings} -> UserAccessLoggingSettings
userAccessLoggingSettings) (\s :: UpdateUserAccessLoggingSettingsResponse
s@UpdateUserAccessLoggingSettingsResponse' {} UserAccessLoggingSettings
a -> UpdateUserAccessLoggingSettingsResponse
s {$sel:userAccessLoggingSettings:UpdateUserAccessLoggingSettingsResponse' :: UserAccessLoggingSettings
userAccessLoggingSettings = UserAccessLoggingSettings
a} :: UpdateUserAccessLoggingSettingsResponse)

instance
  Prelude.NFData
    UpdateUserAccessLoggingSettingsResponse
  where
  rnf :: UpdateUserAccessLoggingSettingsResponse -> ()
rnf UpdateUserAccessLoggingSettingsResponse' {Int
UserAccessLoggingSettings
userAccessLoggingSettings :: UserAccessLoggingSettings
httpStatus :: Int
$sel:userAccessLoggingSettings:UpdateUserAccessLoggingSettingsResponse' :: UpdateUserAccessLoggingSettingsResponse
-> UserAccessLoggingSettings
$sel:httpStatus:UpdateUserAccessLoggingSettingsResponse' :: UpdateUserAccessLoggingSettingsResponse -> Int
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf UserAccessLoggingSettings
userAccessLoggingSettings