{-# 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.CreateUserAccessLoggingSettings
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Creates a user access logging settings resource that can be associated
-- with a web portal.
module Amazonka.WorkSpacesWeb.CreateUserAccessLoggingSettings
  ( -- * Creating a Request
    CreateUserAccessLoggingSettings (..),
    newCreateUserAccessLoggingSettings,

    -- * Request Lenses
    createUserAccessLoggingSettings_clientToken,
    createUserAccessLoggingSettings_tags,
    createUserAccessLoggingSettings_kinesisStreamArn,

    -- * Destructuring the Response
    CreateUserAccessLoggingSettingsResponse (..),
    newCreateUserAccessLoggingSettingsResponse,

    -- * Response Lenses
    createUserAccessLoggingSettingsResponse_httpStatus,
    createUserAccessLoggingSettingsResponse_userAccessLoggingSettingsArn,
  )
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:/ 'newCreateUserAccessLoggingSettings' smart constructor.
data CreateUserAccessLoggingSettings = CreateUserAccessLoggingSettings'
  { -- | 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
    -- returns the result from the original successful request.
    --
    -- If you do not specify a client token, one is automatically generated by
    -- the AWS SDK.
    CreateUserAccessLoggingSettings -> Maybe Text
clientToken :: Prelude.Maybe Prelude.Text,
    -- | The tags to add to the user settings resource. A tag is a key-value
    -- pair.
    CreateUserAccessLoggingSettings -> Maybe [Sensitive Tag]
tags :: Prelude.Maybe [Data.Sensitive Tag],
    -- | The ARN of the Kinesis stream.
    CreateUserAccessLoggingSettings -> Text
kinesisStreamArn :: Prelude.Text
  }
  deriving (CreateUserAccessLoggingSettings
-> CreateUserAccessLoggingSettings -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateUserAccessLoggingSettings
-> CreateUserAccessLoggingSettings -> Bool
$c/= :: CreateUserAccessLoggingSettings
-> CreateUserAccessLoggingSettings -> Bool
== :: CreateUserAccessLoggingSettings
-> CreateUserAccessLoggingSettings -> Bool
$c== :: CreateUserAccessLoggingSettings
-> CreateUserAccessLoggingSettings -> Bool
Prelude.Eq, Int -> CreateUserAccessLoggingSettings -> ShowS
[CreateUserAccessLoggingSettings] -> ShowS
CreateUserAccessLoggingSettings -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateUserAccessLoggingSettings] -> ShowS
$cshowList :: [CreateUserAccessLoggingSettings] -> ShowS
show :: CreateUserAccessLoggingSettings -> String
$cshow :: CreateUserAccessLoggingSettings -> String
showsPrec :: Int -> CreateUserAccessLoggingSettings -> ShowS
$cshowsPrec :: Int -> CreateUserAccessLoggingSettings -> ShowS
Prelude.Show, forall x.
Rep CreateUserAccessLoggingSettings x
-> CreateUserAccessLoggingSettings
forall x.
CreateUserAccessLoggingSettings
-> Rep CreateUserAccessLoggingSettings x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep CreateUserAccessLoggingSettings x
-> CreateUserAccessLoggingSettings
$cfrom :: forall x.
CreateUserAccessLoggingSettings
-> Rep CreateUserAccessLoggingSettings x
Prelude.Generic)

-- |
-- Create a value of 'CreateUserAccessLoggingSettings' 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', 'createUserAccessLoggingSettings_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
-- returns the result from the original successful request.
--
-- If you do not specify a client token, one is automatically generated by
-- the AWS SDK.
--
-- 'tags', 'createUserAccessLoggingSettings_tags' - The tags to add to the user settings resource. A tag is a key-value
-- pair.
--
-- 'kinesisStreamArn', 'createUserAccessLoggingSettings_kinesisStreamArn' - The ARN of the Kinesis stream.
newCreateUserAccessLoggingSettings ::
  -- | 'kinesisStreamArn'
  Prelude.Text ->
  CreateUserAccessLoggingSettings
newCreateUserAccessLoggingSettings :: Text -> CreateUserAccessLoggingSettings
newCreateUserAccessLoggingSettings Text
pKinesisStreamArn_ =
  CreateUserAccessLoggingSettings'
    { $sel:clientToken:CreateUserAccessLoggingSettings' :: Maybe Text
clientToken =
        forall a. Maybe a
Prelude.Nothing,
      $sel:tags:CreateUserAccessLoggingSettings' :: Maybe [Sensitive Tag]
tags = forall a. Maybe a
Prelude.Nothing,
      $sel:kinesisStreamArn:CreateUserAccessLoggingSettings' :: Text
kinesisStreamArn = Text
pKinesisStreamArn_
    }

-- | 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
-- returns the result from the original successful request.
--
-- If you do not specify a client token, one is automatically generated by
-- the AWS SDK.
createUserAccessLoggingSettings_clientToken :: Lens.Lens' CreateUserAccessLoggingSettings (Prelude.Maybe Prelude.Text)
createUserAccessLoggingSettings_clientToken :: Lens' CreateUserAccessLoggingSettings (Maybe Text)
createUserAccessLoggingSettings_clientToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateUserAccessLoggingSettings' {Maybe Text
clientToken :: Maybe Text
$sel:clientToken:CreateUserAccessLoggingSettings' :: CreateUserAccessLoggingSettings -> Maybe Text
clientToken} -> Maybe Text
clientToken) (\s :: CreateUserAccessLoggingSettings
s@CreateUserAccessLoggingSettings' {} Maybe Text
a -> CreateUserAccessLoggingSettings
s {$sel:clientToken:CreateUserAccessLoggingSettings' :: Maybe Text
clientToken = Maybe Text
a} :: CreateUserAccessLoggingSettings)

-- | The tags to add to the user settings resource. A tag is a key-value
-- pair.
createUserAccessLoggingSettings_tags :: Lens.Lens' CreateUserAccessLoggingSettings (Prelude.Maybe [Tag])
createUserAccessLoggingSettings_tags :: Lens' CreateUserAccessLoggingSettings (Maybe [Tag])
createUserAccessLoggingSettings_tags = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateUserAccessLoggingSettings' {Maybe [Sensitive Tag]
tags :: Maybe [Sensitive Tag]
$sel:tags:CreateUserAccessLoggingSettings' :: CreateUserAccessLoggingSettings -> Maybe [Sensitive Tag]
tags} -> Maybe [Sensitive Tag]
tags) (\s :: CreateUserAccessLoggingSettings
s@CreateUserAccessLoggingSettings' {} Maybe [Sensitive Tag]
a -> CreateUserAccessLoggingSettings
s {$sel:tags:CreateUserAccessLoggingSettings' :: Maybe [Sensitive Tag]
tags = Maybe [Sensitive Tag]
a} :: CreateUserAccessLoggingSettings) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall (f :: * -> *) (g :: * -> *) s t a b.
(Functor f, Functor g) =>
AnIso s t a b -> Iso (f s) (g t) (f a) (g b)
Lens.mapping forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Lens.coerced

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

instance
  Core.AWSRequest
    CreateUserAccessLoggingSettings
  where
  type
    AWSResponse CreateUserAccessLoggingSettings =
      CreateUserAccessLoggingSettingsResponse
  request :: (Service -> Service)
-> CreateUserAccessLoggingSettings
-> Request CreateUserAccessLoggingSettings
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 CreateUserAccessLoggingSettings
-> ClientResponse ClientBody
-> m (Either
        Error
        (ClientResponse (AWSResponse CreateUserAccessLoggingSettings)))
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 -> Text -> CreateUserAccessLoggingSettingsResponse
CreateUserAccessLoggingSettingsResponse'
            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
"userAccessLoggingSettingsArn")
      )

instance
  Prelude.Hashable
    CreateUserAccessLoggingSettings
  where
  hashWithSalt :: Int -> CreateUserAccessLoggingSettings -> Int
hashWithSalt
    Int
_salt
    CreateUserAccessLoggingSettings' {Maybe [Sensitive Tag]
Maybe Text
Text
kinesisStreamArn :: Text
tags :: Maybe [Sensitive Tag]
clientToken :: Maybe Text
$sel:kinesisStreamArn:CreateUserAccessLoggingSettings' :: CreateUserAccessLoggingSettings -> Text
$sel:tags:CreateUserAccessLoggingSettings' :: CreateUserAccessLoggingSettings -> Maybe [Sensitive Tag]
$sel:clientToken:CreateUserAccessLoggingSettings' :: CreateUserAccessLoggingSettings -> 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 [Sensitive Tag]
tags
        forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
kinesisStreamArn

instance
  Prelude.NFData
    CreateUserAccessLoggingSettings
  where
  rnf :: CreateUserAccessLoggingSettings -> ()
rnf CreateUserAccessLoggingSettings' {Maybe [Sensitive Tag]
Maybe Text
Text
kinesisStreamArn :: Text
tags :: Maybe [Sensitive Tag]
clientToken :: Maybe Text
$sel:kinesisStreamArn:CreateUserAccessLoggingSettings' :: CreateUserAccessLoggingSettings -> Text
$sel:tags:CreateUserAccessLoggingSettings' :: CreateUserAccessLoggingSettings -> Maybe [Sensitive Tag]
$sel:clientToken:CreateUserAccessLoggingSettings' :: CreateUserAccessLoggingSettings -> 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 [Sensitive Tag]
tags
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
kinesisStreamArn

instance
  Data.ToHeaders
    CreateUserAccessLoggingSettings
  where
  toHeaders :: CreateUserAccessLoggingSettings -> 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 CreateUserAccessLoggingSettings where
  toJSON :: CreateUserAccessLoggingSettings -> Value
toJSON CreateUserAccessLoggingSettings' {Maybe [Sensitive Tag]
Maybe Text
Text
kinesisStreamArn :: Text
tags :: Maybe [Sensitive Tag]
clientToken :: Maybe Text
$sel:kinesisStreamArn:CreateUserAccessLoggingSettings' :: CreateUserAccessLoggingSettings -> Text
$sel:tags:CreateUserAccessLoggingSettings' :: CreateUserAccessLoggingSettings -> Maybe [Sensitive Tag]
$sel:clientToken:CreateUserAccessLoggingSettings' :: CreateUserAccessLoggingSettings -> 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
"tags" 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 [Sensitive Tag]
tags,
            forall a. a -> Maybe a
Prelude.Just
              (Key
"kinesisStreamArn" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
kinesisStreamArn)
          ]
      )

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

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

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

-- |
-- Create a value of 'CreateUserAccessLoggingSettingsResponse' 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', 'createUserAccessLoggingSettingsResponse_httpStatus' - The response's http status code.
--
-- 'userAccessLoggingSettingsArn', 'createUserAccessLoggingSettingsResponse_userAccessLoggingSettingsArn' - The ARN of the user access logging settings.
newCreateUserAccessLoggingSettingsResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  -- | 'userAccessLoggingSettingsArn'
  Prelude.Text ->
  CreateUserAccessLoggingSettingsResponse
newCreateUserAccessLoggingSettingsResponse :: Int -> Text -> CreateUserAccessLoggingSettingsResponse
newCreateUserAccessLoggingSettingsResponse
  Int
pHttpStatus_
  Text
pUserAccessLoggingSettingsArn_ =
    CreateUserAccessLoggingSettingsResponse'
      { $sel:httpStatus:CreateUserAccessLoggingSettingsResponse' :: Int
httpStatus =
          Int
pHttpStatus_,
        $sel:userAccessLoggingSettingsArn:CreateUserAccessLoggingSettingsResponse' :: Text
userAccessLoggingSettingsArn =
          Text
pUserAccessLoggingSettingsArn_
      }

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

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

instance
  Prelude.NFData
    CreateUserAccessLoggingSettingsResponse
  where
  rnf :: CreateUserAccessLoggingSettingsResponse -> ()
rnf CreateUserAccessLoggingSettingsResponse' {Int
Text
userAccessLoggingSettingsArn :: Text
httpStatus :: Int
$sel:userAccessLoggingSettingsArn:CreateUserAccessLoggingSettingsResponse' :: CreateUserAccessLoggingSettingsResponse -> Text
$sel:httpStatus:CreateUserAccessLoggingSettingsResponse' :: CreateUserAccessLoggingSettingsResponse -> 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 Text
userAccessLoggingSettingsArn