{-# 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.Chime.UpdateUserSettings
-- 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 settings for the specified user, such as phone number
-- settings.
module Amazonka.Chime.UpdateUserSettings
  ( -- * Creating a Request
    UpdateUserSettings (..),
    newUpdateUserSettings,

    -- * Request Lenses
    updateUserSettings_accountId,
    updateUserSettings_userId,
    updateUserSettings_userSettings,

    -- * Destructuring the Response
    UpdateUserSettingsResponse (..),
    newUpdateUserSettingsResponse,
  )
where

import Amazonka.Chime.Types
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

-- | /See:/ 'newUpdateUserSettings' smart constructor.
data UpdateUserSettings = UpdateUserSettings'
  { -- | The Amazon Chime account ID.
    UpdateUserSettings -> Text
accountId :: Prelude.Text,
    -- | The user ID.
    UpdateUserSettings -> Text
userId :: Prelude.Text,
    -- | The user settings to update.
    UpdateUserSettings -> UserSettings
userSettings :: UserSettings
  }
  deriving (UpdateUserSettings -> UpdateUserSettings -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UpdateUserSettings -> UpdateUserSettings -> Bool
$c/= :: UpdateUserSettings -> UpdateUserSettings -> Bool
== :: UpdateUserSettings -> UpdateUserSettings -> Bool
$c== :: UpdateUserSettings -> UpdateUserSettings -> Bool
Prelude.Eq, ReadPrec [UpdateUserSettings]
ReadPrec UpdateUserSettings
Int -> ReadS UpdateUserSettings
ReadS [UpdateUserSettings]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [UpdateUserSettings]
$creadListPrec :: ReadPrec [UpdateUserSettings]
readPrec :: ReadPrec UpdateUserSettings
$creadPrec :: ReadPrec UpdateUserSettings
readList :: ReadS [UpdateUserSettings]
$creadList :: ReadS [UpdateUserSettings]
readsPrec :: Int -> ReadS UpdateUserSettings
$creadsPrec :: Int -> ReadS UpdateUserSettings
Prelude.Read, Int -> UpdateUserSettings -> ShowS
[UpdateUserSettings] -> ShowS
UpdateUserSettings -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UpdateUserSettings] -> ShowS
$cshowList :: [UpdateUserSettings] -> ShowS
show :: UpdateUserSettings -> String
$cshow :: UpdateUserSettings -> String
showsPrec :: Int -> UpdateUserSettings -> ShowS
$cshowsPrec :: Int -> UpdateUserSettings -> ShowS
Prelude.Show, forall x. Rep UpdateUserSettings x -> UpdateUserSettings
forall x. UpdateUserSettings -> Rep UpdateUserSettings x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep UpdateUserSettings x -> UpdateUserSettings
$cfrom :: forall x. UpdateUserSettings -> Rep UpdateUserSettings x
Prelude.Generic)

-- |
-- Create a value of 'UpdateUserSettings' 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:
--
-- 'accountId', 'updateUserSettings_accountId' - The Amazon Chime account ID.
--
-- 'userId', 'updateUserSettings_userId' - The user ID.
--
-- 'userSettings', 'updateUserSettings_userSettings' - The user settings to update.
newUpdateUserSettings ::
  -- | 'accountId'
  Prelude.Text ->
  -- | 'userId'
  Prelude.Text ->
  -- | 'userSettings'
  UserSettings ->
  UpdateUserSettings
newUpdateUserSettings :: Text -> Text -> UserSettings -> UpdateUserSettings
newUpdateUserSettings
  Text
pAccountId_
  Text
pUserId_
  UserSettings
pUserSettings_ =
    UpdateUserSettings'
      { $sel:accountId:UpdateUserSettings' :: Text
accountId = Text
pAccountId_,
        $sel:userId:UpdateUserSettings' :: Text
userId = Text
pUserId_,
        $sel:userSettings:UpdateUserSettings' :: UserSettings
userSettings = UserSettings
pUserSettings_
      }

-- | The Amazon Chime account ID.
updateUserSettings_accountId :: Lens.Lens' UpdateUserSettings Prelude.Text
updateUserSettings_accountId :: Lens' UpdateUserSettings Text
updateUserSettings_accountId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateUserSettings' {Text
accountId :: Text
$sel:accountId:UpdateUserSettings' :: UpdateUserSettings -> Text
accountId} -> Text
accountId) (\s :: UpdateUserSettings
s@UpdateUserSettings' {} Text
a -> UpdateUserSettings
s {$sel:accountId:UpdateUserSettings' :: Text
accountId = Text
a} :: UpdateUserSettings)

-- | The user ID.
updateUserSettings_userId :: Lens.Lens' UpdateUserSettings Prelude.Text
updateUserSettings_userId :: Lens' UpdateUserSettings Text
updateUserSettings_userId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateUserSettings' {Text
userId :: Text
$sel:userId:UpdateUserSettings' :: UpdateUserSettings -> Text
userId} -> Text
userId) (\s :: UpdateUserSettings
s@UpdateUserSettings' {} Text
a -> UpdateUserSettings
s {$sel:userId:UpdateUserSettings' :: Text
userId = Text
a} :: UpdateUserSettings)

-- | The user settings to update.
updateUserSettings_userSettings :: Lens.Lens' UpdateUserSettings UserSettings
updateUserSettings_userSettings :: Lens' UpdateUserSettings UserSettings
updateUserSettings_userSettings = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateUserSettings' {UserSettings
userSettings :: UserSettings
$sel:userSettings:UpdateUserSettings' :: UpdateUserSettings -> UserSettings
userSettings} -> UserSettings
userSettings) (\s :: UpdateUserSettings
s@UpdateUserSettings' {} UserSettings
a -> UpdateUserSettings
s {$sel:userSettings:UpdateUserSettings' :: UserSettings
userSettings = UserSettings
a} :: UpdateUserSettings)

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

instance Prelude.Hashable UpdateUserSettings where
  hashWithSalt :: Int -> UpdateUserSettings -> Int
hashWithSalt Int
_salt UpdateUserSettings' {Text
UserSettings
userSettings :: UserSettings
userId :: Text
accountId :: Text
$sel:userSettings:UpdateUserSettings' :: UpdateUserSettings -> UserSettings
$sel:userId:UpdateUserSettings' :: UpdateUserSettings -> Text
$sel:accountId:UpdateUserSettings' :: UpdateUserSettings -> Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
accountId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
userId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` UserSettings
userSettings

instance Prelude.NFData UpdateUserSettings where
  rnf :: UpdateUserSettings -> ()
rnf UpdateUserSettings' {Text
UserSettings
userSettings :: UserSettings
userId :: Text
accountId :: Text
$sel:userSettings:UpdateUserSettings' :: UpdateUserSettings -> UserSettings
$sel:userId:UpdateUserSettings' :: UpdateUserSettings -> Text
$sel:accountId:UpdateUserSettings' :: UpdateUserSettings -> Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Text
accountId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
userId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf UserSettings
userSettings

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

instance Data.ToJSON UpdateUserSettings where
  toJSON :: UpdateUserSettings -> Value
toJSON UpdateUserSettings' {Text
UserSettings
userSettings :: UserSettings
userId :: Text
accountId :: Text
$sel:userSettings:UpdateUserSettings' :: UpdateUserSettings -> UserSettings
$sel:userId:UpdateUserSettings' :: UpdateUserSettings -> Text
$sel:accountId:UpdateUserSettings' :: UpdateUserSettings -> Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [forall a. a -> Maybe a
Prelude.Just (Key
"UserSettings" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= UserSettings
userSettings)]
      )

instance Data.ToPath UpdateUserSettings where
  toPath :: UpdateUserSettings -> ByteString
toPath UpdateUserSettings' {Text
UserSettings
userSettings :: UserSettings
userId :: Text
accountId :: Text
$sel:userSettings:UpdateUserSettings' :: UpdateUserSettings -> UserSettings
$sel:userId:UpdateUserSettings' :: UpdateUserSettings -> Text
$sel:accountId:UpdateUserSettings' :: UpdateUserSettings -> Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"/accounts/",
        forall a. ToByteString a => a -> ByteString
Data.toBS Text
accountId,
        ByteString
"/users/",
        forall a. ToByteString a => a -> ByteString
Data.toBS Text
userId,
        ByteString
"/settings"
      ]

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

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

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

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