{-# 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.ChimeSdkVoice.UpdatePhoneNumber
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- -- | Undocumented operation.
module Amazonka.ChimeSdkVoice.UpdatePhoneNumber
  ( -- * Creating a Request
    UpdatePhoneNumber (..),
    newUpdatePhoneNumber,

    -- * Request Lenses
    updatePhoneNumber_callingName,
    updatePhoneNumber_productType,
    updatePhoneNumber_phoneNumberId,

    -- * Destructuring the Response
    UpdatePhoneNumberResponse (..),
    newUpdatePhoneNumberResponse,

    -- * Response Lenses
    updatePhoneNumberResponse_phoneNumber,
    updatePhoneNumberResponse_httpStatus,
  )
where

import Amazonka.ChimeSdkVoice.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:/ 'newUpdatePhoneNumber' smart constructor.
data UpdatePhoneNumber = UpdatePhoneNumber'
  { UpdatePhoneNumber -> Maybe (Sensitive Text)
callingName :: Prelude.Maybe (Data.Sensitive Prelude.Text),
    UpdatePhoneNumber -> Maybe PhoneNumberProductType
productType :: Prelude.Maybe PhoneNumberProductType,
    UpdatePhoneNumber -> Sensitive Text
phoneNumberId :: Data.Sensitive Prelude.Text
  }
  deriving (UpdatePhoneNumber -> UpdatePhoneNumber -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UpdatePhoneNumber -> UpdatePhoneNumber -> Bool
$c/= :: UpdatePhoneNumber -> UpdatePhoneNumber -> Bool
== :: UpdatePhoneNumber -> UpdatePhoneNumber -> Bool
$c== :: UpdatePhoneNumber -> UpdatePhoneNumber -> Bool
Prelude.Eq, Int -> UpdatePhoneNumber -> ShowS
[UpdatePhoneNumber] -> ShowS
UpdatePhoneNumber -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UpdatePhoneNumber] -> ShowS
$cshowList :: [UpdatePhoneNumber] -> ShowS
show :: UpdatePhoneNumber -> String
$cshow :: UpdatePhoneNumber -> String
showsPrec :: Int -> UpdatePhoneNumber -> ShowS
$cshowsPrec :: Int -> UpdatePhoneNumber -> ShowS
Prelude.Show, forall x. Rep UpdatePhoneNumber x -> UpdatePhoneNumber
forall x. UpdatePhoneNumber -> Rep UpdatePhoneNumber x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep UpdatePhoneNumber x -> UpdatePhoneNumber
$cfrom :: forall x. UpdatePhoneNumber -> Rep UpdatePhoneNumber x
Prelude.Generic)

-- |
-- Create a value of 'UpdatePhoneNumber' 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', 'updatePhoneNumber_callingName' - Undocumented member.
--
-- 'productType', 'updatePhoneNumber_productType' - Undocumented member.
--
-- 'phoneNumberId', 'updatePhoneNumber_phoneNumberId' - Undocumented member.
newUpdatePhoneNumber ::
  -- | 'phoneNumberId'
  Prelude.Text ->
  UpdatePhoneNumber
newUpdatePhoneNumber :: Text -> UpdatePhoneNumber
newUpdatePhoneNumber Text
pPhoneNumberId_ =
  UpdatePhoneNumber'
    { $sel:callingName:UpdatePhoneNumber' :: Maybe (Sensitive Text)
callingName = forall a. Maybe a
Prelude.Nothing,
      $sel:productType:UpdatePhoneNumber' :: Maybe PhoneNumberProductType
productType = forall a. Maybe a
Prelude.Nothing,
      $sel:phoneNumberId:UpdatePhoneNumber' :: Sensitive Text
phoneNumberId =
        forall a. Iso' (Sensitive a) a
Data._Sensitive forall t b. AReview t b -> b -> t
Lens.# Text
pPhoneNumberId_
    }

-- | Undocumented member.
updatePhoneNumber_callingName :: Lens.Lens' UpdatePhoneNumber (Prelude.Maybe Prelude.Text)
updatePhoneNumber_callingName :: Lens' UpdatePhoneNumber (Maybe Text)
updatePhoneNumber_callingName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdatePhoneNumber' {Maybe (Sensitive Text)
callingName :: Maybe (Sensitive Text)
$sel:callingName:UpdatePhoneNumber' :: UpdatePhoneNumber -> Maybe (Sensitive Text)
callingName} -> Maybe (Sensitive Text)
callingName) (\s :: UpdatePhoneNumber
s@UpdatePhoneNumber' {} Maybe (Sensitive Text)
a -> UpdatePhoneNumber
s {$sel:callingName:UpdatePhoneNumber' :: Maybe (Sensitive Text)
callingName = Maybe (Sensitive Text)
a} :: UpdatePhoneNumber) 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 a. Iso' (Sensitive a) a
Data._Sensitive

-- | Undocumented member.
updatePhoneNumber_productType :: Lens.Lens' UpdatePhoneNumber (Prelude.Maybe PhoneNumberProductType)
updatePhoneNumber_productType :: Lens' UpdatePhoneNumber (Maybe PhoneNumberProductType)
updatePhoneNumber_productType = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdatePhoneNumber' {Maybe PhoneNumberProductType
productType :: Maybe PhoneNumberProductType
$sel:productType:UpdatePhoneNumber' :: UpdatePhoneNumber -> Maybe PhoneNumberProductType
productType} -> Maybe PhoneNumberProductType
productType) (\s :: UpdatePhoneNumber
s@UpdatePhoneNumber' {} Maybe PhoneNumberProductType
a -> UpdatePhoneNumber
s {$sel:productType:UpdatePhoneNumber' :: Maybe PhoneNumberProductType
productType = Maybe PhoneNumberProductType
a} :: UpdatePhoneNumber)

-- | Undocumented member.
updatePhoneNumber_phoneNumberId :: Lens.Lens' UpdatePhoneNumber Prelude.Text
updatePhoneNumber_phoneNumberId :: Lens' UpdatePhoneNumber Text
updatePhoneNumber_phoneNumberId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdatePhoneNumber' {Sensitive Text
phoneNumberId :: Sensitive Text
$sel:phoneNumberId:UpdatePhoneNumber' :: UpdatePhoneNumber -> Sensitive Text
phoneNumberId} -> Sensitive Text
phoneNumberId) (\s :: UpdatePhoneNumber
s@UpdatePhoneNumber' {} Sensitive Text
a -> UpdatePhoneNumber
s {$sel:phoneNumberId:UpdatePhoneNumber' :: Sensitive Text
phoneNumberId = Sensitive Text
a} :: UpdatePhoneNumber) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall a. Iso' (Sensitive a) a
Data._Sensitive

instance Core.AWSRequest UpdatePhoneNumber where
  type
    AWSResponse UpdatePhoneNumber =
      UpdatePhoneNumberResponse
  request :: (Service -> Service)
-> UpdatePhoneNumber -> Request UpdatePhoneNumber
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 UpdatePhoneNumber
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse UpdatePhoneNumber)))
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 ->
          Maybe PhoneNumber -> Int -> UpdatePhoneNumberResponse
UpdatePhoneNumberResponse'
            forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"PhoneNumber")
            forall (f :: * -> *) a b. Applicative f => 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))
      )

instance Prelude.Hashable UpdatePhoneNumber where
  hashWithSalt :: Int -> UpdatePhoneNumber -> Int
hashWithSalt Int
_salt UpdatePhoneNumber' {Maybe (Sensitive Text)
Maybe PhoneNumberProductType
Sensitive Text
phoneNumberId :: Sensitive Text
productType :: Maybe PhoneNumberProductType
callingName :: Maybe (Sensitive Text)
$sel:phoneNumberId:UpdatePhoneNumber' :: UpdatePhoneNumber -> Sensitive Text
$sel:productType:UpdatePhoneNumber' :: UpdatePhoneNumber -> Maybe PhoneNumberProductType
$sel:callingName:UpdatePhoneNumber' :: UpdatePhoneNumber -> Maybe (Sensitive Text)
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe (Sensitive Text)
callingName
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe PhoneNumberProductType
productType
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Sensitive Text
phoneNumberId

instance Prelude.NFData UpdatePhoneNumber where
  rnf :: UpdatePhoneNumber -> ()
rnf UpdatePhoneNumber' {Maybe (Sensitive Text)
Maybe PhoneNumberProductType
Sensitive Text
phoneNumberId :: Sensitive Text
productType :: Maybe PhoneNumberProductType
callingName :: Maybe (Sensitive Text)
$sel:phoneNumberId:UpdatePhoneNumber' :: UpdatePhoneNumber -> Sensitive Text
$sel:productType:UpdatePhoneNumber' :: UpdatePhoneNumber -> Maybe PhoneNumberProductType
$sel:callingName:UpdatePhoneNumber' :: UpdatePhoneNumber -> Maybe (Sensitive Text)
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe (Sensitive Text)
callingName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe PhoneNumberProductType
productType
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Sensitive Text
phoneNumberId

instance Data.ToHeaders UpdatePhoneNumber where
  toHeaders :: UpdatePhoneNumber -> ResponseHeaders
toHeaders = forall a b. a -> b -> a
Prelude.const forall a. Monoid a => a
Prelude.mempty

instance Data.ToJSON UpdatePhoneNumber where
  toJSON :: UpdatePhoneNumber -> Value
toJSON UpdatePhoneNumber' {Maybe (Sensitive Text)
Maybe PhoneNumberProductType
Sensitive Text
phoneNumberId :: Sensitive Text
productType :: Maybe PhoneNumberProductType
callingName :: Maybe (Sensitive Text)
$sel:phoneNumberId:UpdatePhoneNumber' :: UpdatePhoneNumber -> Sensitive Text
$sel:productType:UpdatePhoneNumber' :: UpdatePhoneNumber -> Maybe PhoneNumberProductType
$sel:callingName:UpdatePhoneNumber' :: UpdatePhoneNumber -> Maybe (Sensitive Text)
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"CallingName" 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 Text)
callingName,
            (Key
"ProductType" 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 PhoneNumberProductType
productType
          ]
      )

instance Data.ToPath UpdatePhoneNumber where
  toPath :: UpdatePhoneNumber -> ByteString
toPath UpdatePhoneNumber' {Maybe (Sensitive Text)
Maybe PhoneNumberProductType
Sensitive Text
phoneNumberId :: Sensitive Text
productType :: Maybe PhoneNumberProductType
callingName :: Maybe (Sensitive Text)
$sel:phoneNumberId:UpdatePhoneNumber' :: UpdatePhoneNumber -> Sensitive Text
$sel:productType:UpdatePhoneNumber' :: UpdatePhoneNumber -> Maybe PhoneNumberProductType
$sel:callingName:UpdatePhoneNumber' :: UpdatePhoneNumber -> Maybe (Sensitive Text)
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ByteString
"/phone-numbers/", forall a. ToByteString a => a -> ByteString
Data.toBS Sensitive Text
phoneNumberId]

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

-- | /See:/ 'newUpdatePhoneNumberResponse' smart constructor.
data UpdatePhoneNumberResponse = UpdatePhoneNumberResponse'
  { UpdatePhoneNumberResponse -> Maybe PhoneNumber
phoneNumber :: Prelude.Maybe PhoneNumber,
    -- | The response's http status code.
    UpdatePhoneNumberResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (UpdatePhoneNumberResponse -> UpdatePhoneNumberResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UpdatePhoneNumberResponse -> UpdatePhoneNumberResponse -> Bool
$c/= :: UpdatePhoneNumberResponse -> UpdatePhoneNumberResponse -> Bool
== :: UpdatePhoneNumberResponse -> UpdatePhoneNumberResponse -> Bool
$c== :: UpdatePhoneNumberResponse -> UpdatePhoneNumberResponse -> Bool
Prelude.Eq, Int -> UpdatePhoneNumberResponse -> ShowS
[UpdatePhoneNumberResponse] -> ShowS
UpdatePhoneNumberResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UpdatePhoneNumberResponse] -> ShowS
$cshowList :: [UpdatePhoneNumberResponse] -> ShowS
show :: UpdatePhoneNumberResponse -> String
$cshow :: UpdatePhoneNumberResponse -> String
showsPrec :: Int -> UpdatePhoneNumberResponse -> ShowS
$cshowsPrec :: Int -> UpdatePhoneNumberResponse -> ShowS
Prelude.Show, forall x.
Rep UpdatePhoneNumberResponse x -> UpdatePhoneNumberResponse
forall x.
UpdatePhoneNumberResponse -> Rep UpdatePhoneNumberResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep UpdatePhoneNumberResponse x -> UpdatePhoneNumberResponse
$cfrom :: forall x.
UpdatePhoneNumberResponse -> Rep UpdatePhoneNumberResponse x
Prelude.Generic)

-- |
-- Create a value of 'UpdatePhoneNumberResponse' 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:
--
-- 'phoneNumber', 'updatePhoneNumberResponse_phoneNumber' - Undocumented member.
--
-- 'httpStatus', 'updatePhoneNumberResponse_httpStatus' - The response's http status code.
newUpdatePhoneNumberResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  UpdatePhoneNumberResponse
newUpdatePhoneNumberResponse :: Int -> UpdatePhoneNumberResponse
newUpdatePhoneNumberResponse Int
pHttpStatus_ =
  UpdatePhoneNumberResponse'
    { $sel:phoneNumber:UpdatePhoneNumberResponse' :: Maybe PhoneNumber
phoneNumber =
        forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:UpdatePhoneNumberResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | Undocumented member.
updatePhoneNumberResponse_phoneNumber :: Lens.Lens' UpdatePhoneNumberResponse (Prelude.Maybe PhoneNumber)
updatePhoneNumberResponse_phoneNumber :: Lens' UpdatePhoneNumberResponse (Maybe PhoneNumber)
updatePhoneNumberResponse_phoneNumber = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdatePhoneNumberResponse' {Maybe PhoneNumber
phoneNumber :: Maybe PhoneNumber
$sel:phoneNumber:UpdatePhoneNumberResponse' :: UpdatePhoneNumberResponse -> Maybe PhoneNumber
phoneNumber} -> Maybe PhoneNumber
phoneNumber) (\s :: UpdatePhoneNumberResponse
s@UpdatePhoneNumberResponse' {} Maybe PhoneNumber
a -> UpdatePhoneNumberResponse
s {$sel:phoneNumber:UpdatePhoneNumberResponse' :: Maybe PhoneNumber
phoneNumber = Maybe PhoneNumber
a} :: UpdatePhoneNumberResponse)

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

instance Prelude.NFData UpdatePhoneNumberResponse where
  rnf :: UpdatePhoneNumberResponse -> ()
rnf UpdatePhoneNumberResponse' {Int
Maybe PhoneNumber
httpStatus :: Int
phoneNumber :: Maybe PhoneNumber
$sel:httpStatus:UpdatePhoneNumberResponse' :: UpdatePhoneNumberResponse -> Int
$sel:phoneNumber:UpdatePhoneNumberResponse' :: UpdatePhoneNumberResponse -> Maybe PhoneNumber
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe PhoneNumber
phoneNumber
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus