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

    -- * Request Lenses
    associateUserAccessLoggingSettings_portalArn,
    associateUserAccessLoggingSettings_userAccessLoggingSettingsArn,

    -- * Destructuring the Response
    AssociateUserAccessLoggingSettingsResponse (..),
    newAssociateUserAccessLoggingSettingsResponse,

    -- * Response Lenses
    associateUserAccessLoggingSettingsResponse_httpStatus,
    associateUserAccessLoggingSettingsResponse_portalArn,
    associateUserAccessLoggingSettingsResponse_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:/ 'newAssociateUserAccessLoggingSettings' smart constructor.
data AssociateUserAccessLoggingSettings = AssociateUserAccessLoggingSettings'
  { -- | The ARN of the web portal.
    AssociateUserAccessLoggingSettings -> Text
portalArn :: Prelude.Text,
    -- | The ARN of the user access logging settings.
    AssociateUserAccessLoggingSettings -> Text
userAccessLoggingSettingsArn :: Prelude.Text
  }
  deriving (AssociateUserAccessLoggingSettings
-> AssociateUserAccessLoggingSettings -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AssociateUserAccessLoggingSettings
-> AssociateUserAccessLoggingSettings -> Bool
$c/= :: AssociateUserAccessLoggingSettings
-> AssociateUserAccessLoggingSettings -> Bool
== :: AssociateUserAccessLoggingSettings
-> AssociateUserAccessLoggingSettings -> Bool
$c== :: AssociateUserAccessLoggingSettings
-> AssociateUserAccessLoggingSettings -> Bool
Prelude.Eq, ReadPrec [AssociateUserAccessLoggingSettings]
ReadPrec AssociateUserAccessLoggingSettings
Int -> ReadS AssociateUserAccessLoggingSettings
ReadS [AssociateUserAccessLoggingSettings]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [AssociateUserAccessLoggingSettings]
$creadListPrec :: ReadPrec [AssociateUserAccessLoggingSettings]
readPrec :: ReadPrec AssociateUserAccessLoggingSettings
$creadPrec :: ReadPrec AssociateUserAccessLoggingSettings
readList :: ReadS [AssociateUserAccessLoggingSettings]
$creadList :: ReadS [AssociateUserAccessLoggingSettings]
readsPrec :: Int -> ReadS AssociateUserAccessLoggingSettings
$creadsPrec :: Int -> ReadS AssociateUserAccessLoggingSettings
Prelude.Read, Int -> AssociateUserAccessLoggingSettings -> ShowS
[AssociateUserAccessLoggingSettings] -> ShowS
AssociateUserAccessLoggingSettings -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AssociateUserAccessLoggingSettings] -> ShowS
$cshowList :: [AssociateUserAccessLoggingSettings] -> ShowS
show :: AssociateUserAccessLoggingSettings -> String
$cshow :: AssociateUserAccessLoggingSettings -> String
showsPrec :: Int -> AssociateUserAccessLoggingSettings -> ShowS
$cshowsPrec :: Int -> AssociateUserAccessLoggingSettings -> ShowS
Prelude.Show, forall x.
Rep AssociateUserAccessLoggingSettings x
-> AssociateUserAccessLoggingSettings
forall x.
AssociateUserAccessLoggingSettings
-> Rep AssociateUserAccessLoggingSettings x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep AssociateUserAccessLoggingSettings x
-> AssociateUserAccessLoggingSettings
$cfrom :: forall x.
AssociateUserAccessLoggingSettings
-> Rep AssociateUserAccessLoggingSettings x
Prelude.Generic)

-- |
-- Create a value of 'AssociateUserAccessLoggingSettings' 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:
--
-- 'portalArn', 'associateUserAccessLoggingSettings_portalArn' - The ARN of the web portal.
--
-- 'userAccessLoggingSettingsArn', 'associateUserAccessLoggingSettings_userAccessLoggingSettingsArn' - The ARN of the user access logging settings.
newAssociateUserAccessLoggingSettings ::
  -- | 'portalArn'
  Prelude.Text ->
  -- | 'userAccessLoggingSettingsArn'
  Prelude.Text ->
  AssociateUserAccessLoggingSettings
newAssociateUserAccessLoggingSettings :: Text -> Text -> AssociateUserAccessLoggingSettings
newAssociateUserAccessLoggingSettings
  Text
pPortalArn_
  Text
pUserAccessLoggingSettingsArn_ =
    AssociateUserAccessLoggingSettings'
      { $sel:portalArn:AssociateUserAccessLoggingSettings' :: Text
portalArn =
          Text
pPortalArn_,
        $sel:userAccessLoggingSettingsArn:AssociateUserAccessLoggingSettings' :: Text
userAccessLoggingSettingsArn =
          Text
pUserAccessLoggingSettingsArn_
      }

-- | The ARN of the web portal.
associateUserAccessLoggingSettings_portalArn :: Lens.Lens' AssociateUserAccessLoggingSettings Prelude.Text
associateUserAccessLoggingSettings_portalArn :: Lens' AssociateUserAccessLoggingSettings Text
associateUserAccessLoggingSettings_portalArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\AssociateUserAccessLoggingSettings' {Text
portalArn :: Text
$sel:portalArn:AssociateUserAccessLoggingSettings' :: AssociateUserAccessLoggingSettings -> Text
portalArn} -> Text
portalArn) (\s :: AssociateUserAccessLoggingSettings
s@AssociateUserAccessLoggingSettings' {} Text
a -> AssociateUserAccessLoggingSettings
s {$sel:portalArn:AssociateUserAccessLoggingSettings' :: Text
portalArn = Text
a} :: AssociateUserAccessLoggingSettings)

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

instance
  Core.AWSRequest
    AssociateUserAccessLoggingSettings
  where
  type
    AWSResponse AssociateUserAccessLoggingSettings =
      AssociateUserAccessLoggingSettingsResponse
  request :: (Service -> Service)
-> AssociateUserAccessLoggingSettings
-> Request AssociateUserAccessLoggingSettings
request Service -> Service
overrides =
    forall a. (ToRequest a, ToJSON a) => Service -> a -> Request a
Request.putJSON (Service -> Service
overrides Service
defaultService)
  response :: forall (m :: * -> *).
MonadResource m =>
(ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy AssociateUserAccessLoggingSettings
-> ClientResponse ClientBody
-> m (Either
        Error
        (ClientResponse (AWSResponse AssociateUserAccessLoggingSettings)))
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 -> Text -> AssociateUserAccessLoggingSettingsResponse
AssociateUserAccessLoggingSettingsResponse'
            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
"portalArn")
            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
    AssociateUserAccessLoggingSettings
  where
  hashWithSalt :: Int -> AssociateUserAccessLoggingSettings -> Int
hashWithSalt
    Int
_salt
    AssociateUserAccessLoggingSettings' {Text
userAccessLoggingSettingsArn :: Text
portalArn :: Text
$sel:userAccessLoggingSettingsArn:AssociateUserAccessLoggingSettings' :: AssociateUserAccessLoggingSettings -> Text
$sel:portalArn:AssociateUserAccessLoggingSettings' :: AssociateUserAccessLoggingSettings -> Text
..} =
      Int
_salt
        forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
portalArn
        forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
userAccessLoggingSettingsArn

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

instance
  Data.ToHeaders
    AssociateUserAccessLoggingSettings
  where
  toHeaders :: AssociateUserAccessLoggingSettings -> 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
    AssociateUserAccessLoggingSettings
  where
  toJSON :: AssociateUserAccessLoggingSettings -> Value
toJSON = forall a b. a -> b -> a
Prelude.const (Object -> Value
Data.Object forall a. Monoid a => a
Prelude.mempty)

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

instance
  Data.ToQuery
    AssociateUserAccessLoggingSettings
  where
  toQuery :: AssociateUserAccessLoggingSettings -> QueryString
toQuery AssociateUserAccessLoggingSettings' {Text
userAccessLoggingSettingsArn :: Text
portalArn :: Text
$sel:userAccessLoggingSettingsArn:AssociateUserAccessLoggingSettings' :: AssociateUserAccessLoggingSettings -> Text
$sel:portalArn:AssociateUserAccessLoggingSettings' :: AssociateUserAccessLoggingSettings -> Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"userAccessLoggingSettingsArn"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Text
userAccessLoggingSettingsArn
      ]

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

-- |
-- Create a value of 'AssociateUserAccessLoggingSettingsResponse' 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', 'associateUserAccessLoggingSettingsResponse_httpStatus' - The response's http status code.
--
-- 'portalArn', 'associateUserAccessLoggingSettingsResponse_portalArn' - The ARN of the web portal.
--
-- 'userAccessLoggingSettingsArn', 'associateUserAccessLoggingSettingsResponse_userAccessLoggingSettingsArn' - The ARN of the user access logging settings.
newAssociateUserAccessLoggingSettingsResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  -- | 'portalArn'
  Prelude.Text ->
  -- | 'userAccessLoggingSettingsArn'
  Prelude.Text ->
  AssociateUserAccessLoggingSettingsResponse
newAssociateUserAccessLoggingSettingsResponse :: Int -> Text -> Text -> AssociateUserAccessLoggingSettingsResponse
newAssociateUserAccessLoggingSettingsResponse
  Int
pHttpStatus_
  Text
pPortalArn_
  Text
pUserAccessLoggingSettingsArn_ =
    AssociateUserAccessLoggingSettingsResponse'
      { $sel:httpStatus:AssociateUserAccessLoggingSettingsResponse' :: Int
httpStatus =
          Int
pHttpStatus_,
        $sel:portalArn:AssociateUserAccessLoggingSettingsResponse' :: Text
portalArn = Text
pPortalArn_,
        $sel:userAccessLoggingSettingsArn:AssociateUserAccessLoggingSettingsResponse' :: Text
userAccessLoggingSettingsArn =
          Text
pUserAccessLoggingSettingsArn_
      }

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

-- | The ARN of the web portal.
associateUserAccessLoggingSettingsResponse_portalArn :: Lens.Lens' AssociateUserAccessLoggingSettingsResponse Prelude.Text
associateUserAccessLoggingSettingsResponse_portalArn :: Lens' AssociateUserAccessLoggingSettingsResponse Text
associateUserAccessLoggingSettingsResponse_portalArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\AssociateUserAccessLoggingSettingsResponse' {Text
portalArn :: Text
$sel:portalArn:AssociateUserAccessLoggingSettingsResponse' :: AssociateUserAccessLoggingSettingsResponse -> Text
portalArn} -> Text
portalArn) (\s :: AssociateUserAccessLoggingSettingsResponse
s@AssociateUserAccessLoggingSettingsResponse' {} Text
a -> AssociateUserAccessLoggingSettingsResponse
s {$sel:portalArn:AssociateUserAccessLoggingSettingsResponse' :: Text
portalArn = Text
a} :: AssociateUserAccessLoggingSettingsResponse)

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

instance
  Prelude.NFData
    AssociateUserAccessLoggingSettingsResponse
  where
  rnf :: AssociateUserAccessLoggingSettingsResponse -> ()
rnf AssociateUserAccessLoggingSettingsResponse' {Int
Text
userAccessLoggingSettingsArn :: Text
portalArn :: Text
httpStatus :: Int
$sel:userAccessLoggingSettingsArn:AssociateUserAccessLoggingSettingsResponse' :: AssociateUserAccessLoggingSettingsResponse -> Text
$sel:portalArn:AssociateUserAccessLoggingSettingsResponse' :: AssociateUserAccessLoggingSettingsResponse -> Text
$sel:httpStatus:AssociateUserAccessLoggingSettingsResponse' :: AssociateUserAccessLoggingSettingsResponse -> 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
portalArn
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
userAccessLoggingSettingsArn