{-# 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.AssociateUserSettings
-- 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 settings resource with a web portal.
module Amazonka.WorkSpacesWeb.AssociateUserSettings
  ( -- * Creating a Request
    AssociateUserSettings (..),
    newAssociateUserSettings,

    -- * Request Lenses
    associateUserSettings_portalArn,
    associateUserSettings_userSettingsArn,

    -- * Destructuring the Response
    AssociateUserSettingsResponse (..),
    newAssociateUserSettingsResponse,

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

-- |
-- Create a value of 'AssociateUserSettings' 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', 'associateUserSettings_portalArn' - The ARN of the web portal.
--
-- 'userSettingsArn', 'associateUserSettings_userSettingsArn' - The ARN of the user settings.
newAssociateUserSettings ::
  -- | 'portalArn'
  Prelude.Text ->
  -- | 'userSettingsArn'
  Prelude.Text ->
  AssociateUserSettings
newAssociateUserSettings :: Text -> Text -> AssociateUserSettings
newAssociateUserSettings
  Text
pPortalArn_
  Text
pUserSettingsArn_ =
    AssociateUserSettings'
      { $sel:portalArn:AssociateUserSettings' :: Text
portalArn = Text
pPortalArn_,
        $sel:userSettingsArn:AssociateUserSettings' :: Text
userSettingsArn = Text
pUserSettingsArn_
      }

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

-- | The ARN of the user settings.
associateUserSettings_userSettingsArn :: Lens.Lens' AssociateUserSettings Prelude.Text
associateUserSettings_userSettingsArn :: Lens' AssociateUserSettings Text
associateUserSettings_userSettingsArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\AssociateUserSettings' {Text
userSettingsArn :: Text
$sel:userSettingsArn:AssociateUserSettings' :: AssociateUserSettings -> Text
userSettingsArn} -> Text
userSettingsArn) (\s :: AssociateUserSettings
s@AssociateUserSettings' {} Text
a -> AssociateUserSettings
s {$sel:userSettingsArn:AssociateUserSettings' :: Text
userSettingsArn = Text
a} :: AssociateUserSettings)

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

instance Prelude.Hashable AssociateUserSettings where
  hashWithSalt :: Int -> AssociateUserSettings -> Int
hashWithSalt Int
_salt AssociateUserSettings' {Text
userSettingsArn :: Text
portalArn :: Text
$sel:userSettingsArn:AssociateUserSettings' :: AssociateUserSettings -> Text
$sel:portalArn:AssociateUserSettings' :: AssociateUserSettings -> Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
portalArn
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
userSettingsArn

instance Prelude.NFData AssociateUserSettings where
  rnf :: AssociateUserSettings -> ()
rnf AssociateUserSettings' {Text
userSettingsArn :: Text
portalArn :: Text
$sel:userSettingsArn:AssociateUserSettings' :: AssociateUserSettings -> Text
$sel:portalArn:AssociateUserSettings' :: AssociateUserSettings -> 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
userSettingsArn

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

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

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

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

-- |
-- Create a value of 'AssociateUserSettingsResponse' 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', 'associateUserSettingsResponse_httpStatus' - The response's http status code.
--
-- 'portalArn', 'associateUserSettingsResponse_portalArn' - The ARN of the web portal.
--
-- 'userSettingsArn', 'associateUserSettingsResponse_userSettingsArn' - The ARN of the user settings.
newAssociateUserSettingsResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  -- | 'portalArn'
  Prelude.Text ->
  -- | 'userSettingsArn'
  Prelude.Text ->
  AssociateUserSettingsResponse
newAssociateUserSettingsResponse :: Int -> Text -> Text -> AssociateUserSettingsResponse
newAssociateUserSettingsResponse
  Int
pHttpStatus_
  Text
pPortalArn_
  Text
pUserSettingsArn_ =
    AssociateUserSettingsResponse'
      { $sel:httpStatus:AssociateUserSettingsResponse' :: Int
httpStatus =
          Int
pHttpStatus_,
        $sel:portalArn:AssociateUserSettingsResponse' :: Text
portalArn = Text
pPortalArn_,
        $sel:userSettingsArn:AssociateUserSettingsResponse' :: Text
userSettingsArn = Text
pUserSettingsArn_
      }

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

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

-- | The ARN of the user settings.
associateUserSettingsResponse_userSettingsArn :: Lens.Lens' AssociateUserSettingsResponse Prelude.Text
associateUserSettingsResponse_userSettingsArn :: Lens' AssociateUserSettingsResponse Text
associateUserSettingsResponse_userSettingsArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\AssociateUserSettingsResponse' {Text
userSettingsArn :: Text
$sel:userSettingsArn:AssociateUserSettingsResponse' :: AssociateUserSettingsResponse -> Text
userSettingsArn} -> Text
userSettingsArn) (\s :: AssociateUserSettingsResponse
s@AssociateUserSettingsResponse' {} Text
a -> AssociateUserSettingsResponse
s {$sel:userSettingsArn:AssociateUserSettingsResponse' :: Text
userSettingsArn = Text
a} :: AssociateUserSettingsResponse)

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