{-# 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.Pinpoint.UpdateVoiceChannel
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Enables the voice channel for an application or updates the status and
-- settings of the voice channel for an application.
module Amazonka.Pinpoint.UpdateVoiceChannel
  ( -- * Creating a Request
    UpdateVoiceChannel (..),
    newUpdateVoiceChannel,

    -- * Request Lenses
    updateVoiceChannel_applicationId,
    updateVoiceChannel_voiceChannelRequest,

    -- * Destructuring the Response
    UpdateVoiceChannelResponse (..),
    newUpdateVoiceChannelResponse,

    -- * Response Lenses
    updateVoiceChannelResponse_httpStatus,
    updateVoiceChannelResponse_voiceChannelResponse,
  )
where

import qualified Amazonka.Core as Core
import qualified Amazonka.Core.Lens.Internal as Lens
import qualified Amazonka.Data as Data
import Amazonka.Pinpoint.Types
import qualified Amazonka.Prelude as Prelude
import qualified Amazonka.Request as Request
import qualified Amazonka.Response as Response

-- | /See:/ 'newUpdateVoiceChannel' smart constructor.
data UpdateVoiceChannel = UpdateVoiceChannel'
  { -- | The unique identifier for the application. This identifier is displayed
    -- as the __Project ID__ on the Amazon Pinpoint console.
    UpdateVoiceChannel -> Text
applicationId :: Prelude.Text,
    UpdateVoiceChannel -> VoiceChannelRequest
voiceChannelRequest :: VoiceChannelRequest
  }
  deriving (UpdateVoiceChannel -> UpdateVoiceChannel -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UpdateVoiceChannel -> UpdateVoiceChannel -> Bool
$c/= :: UpdateVoiceChannel -> UpdateVoiceChannel -> Bool
== :: UpdateVoiceChannel -> UpdateVoiceChannel -> Bool
$c== :: UpdateVoiceChannel -> UpdateVoiceChannel -> Bool
Prelude.Eq, ReadPrec [UpdateVoiceChannel]
ReadPrec UpdateVoiceChannel
Int -> ReadS UpdateVoiceChannel
ReadS [UpdateVoiceChannel]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [UpdateVoiceChannel]
$creadListPrec :: ReadPrec [UpdateVoiceChannel]
readPrec :: ReadPrec UpdateVoiceChannel
$creadPrec :: ReadPrec UpdateVoiceChannel
readList :: ReadS [UpdateVoiceChannel]
$creadList :: ReadS [UpdateVoiceChannel]
readsPrec :: Int -> ReadS UpdateVoiceChannel
$creadsPrec :: Int -> ReadS UpdateVoiceChannel
Prelude.Read, Int -> UpdateVoiceChannel -> ShowS
[UpdateVoiceChannel] -> ShowS
UpdateVoiceChannel -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UpdateVoiceChannel] -> ShowS
$cshowList :: [UpdateVoiceChannel] -> ShowS
show :: UpdateVoiceChannel -> String
$cshow :: UpdateVoiceChannel -> String
showsPrec :: Int -> UpdateVoiceChannel -> ShowS
$cshowsPrec :: Int -> UpdateVoiceChannel -> ShowS
Prelude.Show, forall x. Rep UpdateVoiceChannel x -> UpdateVoiceChannel
forall x. UpdateVoiceChannel -> Rep UpdateVoiceChannel x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep UpdateVoiceChannel x -> UpdateVoiceChannel
$cfrom :: forall x. UpdateVoiceChannel -> Rep UpdateVoiceChannel x
Prelude.Generic)

-- |
-- Create a value of 'UpdateVoiceChannel' 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:
--
-- 'applicationId', 'updateVoiceChannel_applicationId' - The unique identifier for the application. This identifier is displayed
-- as the __Project ID__ on the Amazon Pinpoint console.
--
-- 'voiceChannelRequest', 'updateVoiceChannel_voiceChannelRequest' - Undocumented member.
newUpdateVoiceChannel ::
  -- | 'applicationId'
  Prelude.Text ->
  -- | 'voiceChannelRequest'
  VoiceChannelRequest ->
  UpdateVoiceChannel
newUpdateVoiceChannel :: Text -> VoiceChannelRequest -> UpdateVoiceChannel
newUpdateVoiceChannel
  Text
pApplicationId_
  VoiceChannelRequest
pVoiceChannelRequest_ =
    UpdateVoiceChannel'
      { $sel:applicationId:UpdateVoiceChannel' :: Text
applicationId =
          Text
pApplicationId_,
        $sel:voiceChannelRequest:UpdateVoiceChannel' :: VoiceChannelRequest
voiceChannelRequest = VoiceChannelRequest
pVoiceChannelRequest_
      }

-- | The unique identifier for the application. This identifier is displayed
-- as the __Project ID__ on the Amazon Pinpoint console.
updateVoiceChannel_applicationId :: Lens.Lens' UpdateVoiceChannel Prelude.Text
updateVoiceChannel_applicationId :: Lens' UpdateVoiceChannel Text
updateVoiceChannel_applicationId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateVoiceChannel' {Text
applicationId :: Text
$sel:applicationId:UpdateVoiceChannel' :: UpdateVoiceChannel -> Text
applicationId} -> Text
applicationId) (\s :: UpdateVoiceChannel
s@UpdateVoiceChannel' {} Text
a -> UpdateVoiceChannel
s {$sel:applicationId:UpdateVoiceChannel' :: Text
applicationId = Text
a} :: UpdateVoiceChannel)

-- | Undocumented member.
updateVoiceChannel_voiceChannelRequest :: Lens.Lens' UpdateVoiceChannel VoiceChannelRequest
updateVoiceChannel_voiceChannelRequest :: Lens' UpdateVoiceChannel VoiceChannelRequest
updateVoiceChannel_voiceChannelRequest = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateVoiceChannel' {VoiceChannelRequest
voiceChannelRequest :: VoiceChannelRequest
$sel:voiceChannelRequest:UpdateVoiceChannel' :: UpdateVoiceChannel -> VoiceChannelRequest
voiceChannelRequest} -> VoiceChannelRequest
voiceChannelRequest) (\s :: UpdateVoiceChannel
s@UpdateVoiceChannel' {} VoiceChannelRequest
a -> UpdateVoiceChannel
s {$sel:voiceChannelRequest:UpdateVoiceChannel' :: VoiceChannelRequest
voiceChannelRequest = VoiceChannelRequest
a} :: UpdateVoiceChannel)

instance Core.AWSRequest UpdateVoiceChannel where
  type
    AWSResponse UpdateVoiceChannel =
      UpdateVoiceChannelResponse
  request :: (Service -> Service)
-> UpdateVoiceChannel -> Request UpdateVoiceChannel
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 UpdateVoiceChannel
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse UpdateVoiceChannel)))
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 -> VoiceChannelResponse -> UpdateVoiceChannelResponse
UpdateVoiceChannelResponse'
            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.<*> (forall a. FromJSON a => Object -> Either String a
Data.eitherParseJSON Object
x)
      )

instance Prelude.Hashable UpdateVoiceChannel where
  hashWithSalt :: Int -> UpdateVoiceChannel -> Int
hashWithSalt Int
_salt UpdateVoiceChannel' {Text
VoiceChannelRequest
voiceChannelRequest :: VoiceChannelRequest
applicationId :: Text
$sel:voiceChannelRequest:UpdateVoiceChannel' :: UpdateVoiceChannel -> VoiceChannelRequest
$sel:applicationId:UpdateVoiceChannel' :: UpdateVoiceChannel -> Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
applicationId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` VoiceChannelRequest
voiceChannelRequest

instance Prelude.NFData UpdateVoiceChannel where
  rnf :: UpdateVoiceChannel -> ()
rnf UpdateVoiceChannel' {Text
VoiceChannelRequest
voiceChannelRequest :: VoiceChannelRequest
applicationId :: Text
$sel:voiceChannelRequest:UpdateVoiceChannel' :: UpdateVoiceChannel -> VoiceChannelRequest
$sel:applicationId:UpdateVoiceChannel' :: UpdateVoiceChannel -> Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Text
applicationId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf VoiceChannelRequest
voiceChannelRequest

instance Data.ToHeaders UpdateVoiceChannel where
  toHeaders :: UpdateVoiceChannel -> 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 UpdateVoiceChannel where
  toJSON :: UpdateVoiceChannel -> Value
toJSON UpdateVoiceChannel' {Text
VoiceChannelRequest
voiceChannelRequest :: VoiceChannelRequest
applicationId :: Text
$sel:voiceChannelRequest:UpdateVoiceChannel' :: UpdateVoiceChannel -> VoiceChannelRequest
$sel:applicationId:UpdateVoiceChannel' :: UpdateVoiceChannel -> Text
..} =
    forall a. ToJSON a => a -> Value
Data.toJSON VoiceChannelRequest
voiceChannelRequest

instance Data.ToPath UpdateVoiceChannel where
  toPath :: UpdateVoiceChannel -> ByteString
toPath UpdateVoiceChannel' {Text
VoiceChannelRequest
voiceChannelRequest :: VoiceChannelRequest
applicationId :: Text
$sel:voiceChannelRequest:UpdateVoiceChannel' :: UpdateVoiceChannel -> VoiceChannelRequest
$sel:applicationId:UpdateVoiceChannel' :: UpdateVoiceChannel -> Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"/v1/apps/",
        forall a. ToByteString a => a -> ByteString
Data.toBS Text
applicationId,
        ByteString
"/channels/voice"
      ]

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

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

-- |
-- Create a value of 'UpdateVoiceChannelResponse' 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', 'updateVoiceChannelResponse_httpStatus' - The response's http status code.
--
-- 'voiceChannelResponse', 'updateVoiceChannelResponse_voiceChannelResponse' - Undocumented member.
newUpdateVoiceChannelResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  -- | 'voiceChannelResponse'
  VoiceChannelResponse ->
  UpdateVoiceChannelResponse
newUpdateVoiceChannelResponse :: Int -> VoiceChannelResponse -> UpdateVoiceChannelResponse
newUpdateVoiceChannelResponse
  Int
pHttpStatus_
  VoiceChannelResponse
pVoiceChannelResponse_ =
    UpdateVoiceChannelResponse'
      { $sel:httpStatus:UpdateVoiceChannelResponse' :: Int
httpStatus =
          Int
pHttpStatus_,
        $sel:voiceChannelResponse:UpdateVoiceChannelResponse' :: VoiceChannelResponse
voiceChannelResponse = VoiceChannelResponse
pVoiceChannelResponse_
      }

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

-- | Undocumented member.
updateVoiceChannelResponse_voiceChannelResponse :: Lens.Lens' UpdateVoiceChannelResponse VoiceChannelResponse
updateVoiceChannelResponse_voiceChannelResponse :: Lens' UpdateVoiceChannelResponse VoiceChannelResponse
updateVoiceChannelResponse_voiceChannelResponse = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateVoiceChannelResponse' {VoiceChannelResponse
voiceChannelResponse :: VoiceChannelResponse
$sel:voiceChannelResponse:UpdateVoiceChannelResponse' :: UpdateVoiceChannelResponse -> VoiceChannelResponse
voiceChannelResponse} -> VoiceChannelResponse
voiceChannelResponse) (\s :: UpdateVoiceChannelResponse
s@UpdateVoiceChannelResponse' {} VoiceChannelResponse
a -> UpdateVoiceChannelResponse
s {$sel:voiceChannelResponse:UpdateVoiceChannelResponse' :: VoiceChannelResponse
voiceChannelResponse = VoiceChannelResponse
a} :: UpdateVoiceChannelResponse)

instance Prelude.NFData UpdateVoiceChannelResponse where
  rnf :: UpdateVoiceChannelResponse -> ()
rnf UpdateVoiceChannelResponse' {Int
VoiceChannelResponse
voiceChannelResponse :: VoiceChannelResponse
httpStatus :: Int
$sel:voiceChannelResponse:UpdateVoiceChannelResponse' :: UpdateVoiceChannelResponse -> VoiceChannelResponse
$sel:httpStatus:UpdateVoiceChannelResponse' :: UpdateVoiceChannelResponse -> 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 VoiceChannelResponse
voiceChannelResponse