{-# 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.UpdatePhoneNumberSettings
-- 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 phone number settings for the administrator\'s AWS account,
-- such as the default outbound calling name. You can update the default
-- outbound calling name once every seven days. Outbound calling names can
-- take up to 72 hours to update.
module Amazonka.Chime.UpdatePhoneNumberSettings
  ( -- * Creating a Request
    UpdatePhoneNumberSettings (..),
    newUpdatePhoneNumberSettings,

    -- * Request Lenses
    updatePhoneNumberSettings_callingName,

    -- * Destructuring the Response
    UpdatePhoneNumberSettingsResponse (..),
    newUpdatePhoneNumberSettingsResponse,
  )
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:/ 'newUpdatePhoneNumberSettings' smart constructor.
data UpdatePhoneNumberSettings = UpdatePhoneNumberSettings'
  { -- | The default outbound calling name for the account.
    UpdatePhoneNumberSettings -> Sensitive Text
callingName :: Data.Sensitive Prelude.Text
  }
  deriving (UpdatePhoneNumberSettings -> UpdatePhoneNumberSettings -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UpdatePhoneNumberSettings -> UpdatePhoneNumberSettings -> Bool
$c/= :: UpdatePhoneNumberSettings -> UpdatePhoneNumberSettings -> Bool
== :: UpdatePhoneNumberSettings -> UpdatePhoneNumberSettings -> Bool
$c== :: UpdatePhoneNumberSettings -> UpdatePhoneNumberSettings -> Bool
Prelude.Eq, Int -> UpdatePhoneNumberSettings -> ShowS
[UpdatePhoneNumberSettings] -> ShowS
UpdatePhoneNumberSettings -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UpdatePhoneNumberSettings] -> ShowS
$cshowList :: [UpdatePhoneNumberSettings] -> ShowS
show :: UpdatePhoneNumberSettings -> String
$cshow :: UpdatePhoneNumberSettings -> String
showsPrec :: Int -> UpdatePhoneNumberSettings -> ShowS
$cshowsPrec :: Int -> UpdatePhoneNumberSettings -> ShowS
Prelude.Show, forall x.
Rep UpdatePhoneNumberSettings x -> UpdatePhoneNumberSettings
forall x.
UpdatePhoneNumberSettings -> Rep UpdatePhoneNumberSettings x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep UpdatePhoneNumberSettings x -> UpdatePhoneNumberSettings
$cfrom :: forall x.
UpdatePhoneNumberSettings -> Rep UpdatePhoneNumberSettings x
Prelude.Generic)

-- |
-- Create a value of 'UpdatePhoneNumberSettings' 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:
--
-- 'callingName', 'updatePhoneNumberSettings_callingName' - The default outbound calling name for the account.
newUpdatePhoneNumberSettings ::
  -- | 'callingName'
  Prelude.Text ->
  UpdatePhoneNumberSettings
newUpdatePhoneNumberSettings :: Text -> UpdatePhoneNumberSettings
newUpdatePhoneNumberSettings Text
pCallingName_ =
  UpdatePhoneNumberSettings'
    { $sel:callingName:UpdatePhoneNumberSettings' :: Sensitive Text
callingName =
        forall a. Iso' (Sensitive a) a
Data._Sensitive forall t b. AReview t b -> b -> t
Lens.# Text
pCallingName_
    }

-- | The default outbound calling name for the account.
updatePhoneNumberSettings_callingName :: Lens.Lens' UpdatePhoneNumberSettings Prelude.Text
updatePhoneNumberSettings_callingName :: Lens' UpdatePhoneNumberSettings Text
updatePhoneNumberSettings_callingName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdatePhoneNumberSettings' {Sensitive Text
callingName :: Sensitive Text
$sel:callingName:UpdatePhoneNumberSettings' :: UpdatePhoneNumberSettings -> Sensitive Text
callingName} -> Sensitive Text
callingName) (\s :: UpdatePhoneNumberSettings
s@UpdatePhoneNumberSettings' {} Sensitive Text
a -> UpdatePhoneNumberSettings
s {$sel:callingName:UpdatePhoneNumberSettings' :: Sensitive Text
callingName = Sensitive Text
a} :: UpdatePhoneNumberSettings) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall a. Iso' (Sensitive a) a
Data._Sensitive

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

instance Prelude.Hashable UpdatePhoneNumberSettings where
  hashWithSalt :: Int -> UpdatePhoneNumberSettings -> Int
hashWithSalt Int
_salt UpdatePhoneNumberSettings' {Sensitive Text
callingName :: Sensitive Text
$sel:callingName:UpdatePhoneNumberSettings' :: UpdatePhoneNumberSettings -> Sensitive Text
..} =
    Int
_salt forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Sensitive Text
callingName

instance Prelude.NFData UpdatePhoneNumberSettings where
  rnf :: UpdatePhoneNumberSettings -> ()
rnf UpdatePhoneNumberSettings' {Sensitive Text
callingName :: Sensitive Text
$sel:callingName:UpdatePhoneNumberSettings' :: UpdatePhoneNumberSettings -> Sensitive Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Sensitive Text
callingName

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

instance Data.ToJSON UpdatePhoneNumberSettings where
  toJSON :: UpdatePhoneNumberSettings -> Value
toJSON UpdatePhoneNumberSettings' {Sensitive Text
callingName :: Sensitive Text
$sel:callingName:UpdatePhoneNumberSettings' :: UpdatePhoneNumberSettings -> Sensitive Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [forall a. a -> Maybe a
Prelude.Just (Key
"CallingName" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Sensitive Text
callingName)]
      )

instance Data.ToPath UpdatePhoneNumberSettings where
  toPath :: UpdatePhoneNumberSettings -> ByteString
toPath = forall a b. a -> b -> a
Prelude.const ByteString
"/settings/phone-number"

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

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

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

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