{-# 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.UpdateSmsChannel
-- 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 SMS channel for an application or updates the status and
-- settings of the SMS channel for an application.
module Amazonka.Pinpoint.UpdateSmsChannel
  ( -- * Creating a Request
    UpdateSmsChannel (..),
    newUpdateSmsChannel,

    -- * Request Lenses
    updateSmsChannel_applicationId,
    updateSmsChannel_sMSChannelRequest,

    -- * Destructuring the Response
    UpdateSmsChannelResponse (..),
    newUpdateSmsChannelResponse,

    -- * Response Lenses
    updateSmsChannelResponse_httpStatus,
    updateSmsChannelResponse_sMSChannelResponse,
  )
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:/ 'newUpdateSmsChannel' smart constructor.
data UpdateSmsChannel = UpdateSmsChannel'
  { -- | The unique identifier for the application. This identifier is displayed
    -- as the __Project ID__ on the Amazon Pinpoint console.
    UpdateSmsChannel -> Text
applicationId :: Prelude.Text,
    UpdateSmsChannel -> SMSChannelRequest
sMSChannelRequest :: SMSChannelRequest
  }
  deriving (UpdateSmsChannel -> UpdateSmsChannel -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UpdateSmsChannel -> UpdateSmsChannel -> Bool
$c/= :: UpdateSmsChannel -> UpdateSmsChannel -> Bool
== :: UpdateSmsChannel -> UpdateSmsChannel -> Bool
$c== :: UpdateSmsChannel -> UpdateSmsChannel -> Bool
Prelude.Eq, ReadPrec [UpdateSmsChannel]
ReadPrec UpdateSmsChannel
Int -> ReadS UpdateSmsChannel
ReadS [UpdateSmsChannel]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [UpdateSmsChannel]
$creadListPrec :: ReadPrec [UpdateSmsChannel]
readPrec :: ReadPrec UpdateSmsChannel
$creadPrec :: ReadPrec UpdateSmsChannel
readList :: ReadS [UpdateSmsChannel]
$creadList :: ReadS [UpdateSmsChannel]
readsPrec :: Int -> ReadS UpdateSmsChannel
$creadsPrec :: Int -> ReadS UpdateSmsChannel
Prelude.Read, Int -> UpdateSmsChannel -> ShowS
[UpdateSmsChannel] -> ShowS
UpdateSmsChannel -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UpdateSmsChannel] -> ShowS
$cshowList :: [UpdateSmsChannel] -> ShowS
show :: UpdateSmsChannel -> String
$cshow :: UpdateSmsChannel -> String
showsPrec :: Int -> UpdateSmsChannel -> ShowS
$cshowsPrec :: Int -> UpdateSmsChannel -> ShowS
Prelude.Show, forall x. Rep UpdateSmsChannel x -> UpdateSmsChannel
forall x. UpdateSmsChannel -> Rep UpdateSmsChannel x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep UpdateSmsChannel x -> UpdateSmsChannel
$cfrom :: forall x. UpdateSmsChannel -> Rep UpdateSmsChannel x
Prelude.Generic)

-- |
-- Create a value of 'UpdateSmsChannel' 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', 'updateSmsChannel_applicationId' - The unique identifier for the application. This identifier is displayed
-- as the __Project ID__ on the Amazon Pinpoint console.
--
-- 'sMSChannelRequest', 'updateSmsChannel_sMSChannelRequest' - Undocumented member.
newUpdateSmsChannel ::
  -- | 'applicationId'
  Prelude.Text ->
  -- | 'sMSChannelRequest'
  SMSChannelRequest ->
  UpdateSmsChannel
newUpdateSmsChannel :: Text -> SMSChannelRequest -> UpdateSmsChannel
newUpdateSmsChannel
  Text
pApplicationId_
  SMSChannelRequest
pSMSChannelRequest_ =
    UpdateSmsChannel'
      { $sel:applicationId:UpdateSmsChannel' :: Text
applicationId = Text
pApplicationId_,
        $sel:sMSChannelRequest:UpdateSmsChannel' :: SMSChannelRequest
sMSChannelRequest = SMSChannelRequest
pSMSChannelRequest_
      }

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

-- | Undocumented member.
updateSmsChannel_sMSChannelRequest :: Lens.Lens' UpdateSmsChannel SMSChannelRequest
updateSmsChannel_sMSChannelRequest :: Lens' UpdateSmsChannel SMSChannelRequest
updateSmsChannel_sMSChannelRequest = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateSmsChannel' {SMSChannelRequest
sMSChannelRequest :: SMSChannelRequest
$sel:sMSChannelRequest:UpdateSmsChannel' :: UpdateSmsChannel -> SMSChannelRequest
sMSChannelRequest} -> SMSChannelRequest
sMSChannelRequest) (\s :: UpdateSmsChannel
s@UpdateSmsChannel' {} SMSChannelRequest
a -> UpdateSmsChannel
s {$sel:sMSChannelRequest:UpdateSmsChannel' :: SMSChannelRequest
sMSChannelRequest = SMSChannelRequest
a} :: UpdateSmsChannel)

instance Core.AWSRequest UpdateSmsChannel where
  type
    AWSResponse UpdateSmsChannel =
      UpdateSmsChannelResponse
  request :: (Service -> Service)
-> UpdateSmsChannel -> Request UpdateSmsChannel
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 UpdateSmsChannel
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse UpdateSmsChannel)))
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 -> SMSChannelResponse -> UpdateSmsChannelResponse
UpdateSmsChannelResponse'
            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 UpdateSmsChannel where
  hashWithSalt :: Int -> UpdateSmsChannel -> Int
hashWithSalt Int
_salt UpdateSmsChannel' {Text
SMSChannelRequest
sMSChannelRequest :: SMSChannelRequest
applicationId :: Text
$sel:sMSChannelRequest:UpdateSmsChannel' :: UpdateSmsChannel -> SMSChannelRequest
$sel:applicationId:UpdateSmsChannel' :: UpdateSmsChannel -> Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
applicationId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` SMSChannelRequest
sMSChannelRequest

instance Prelude.NFData UpdateSmsChannel where
  rnf :: UpdateSmsChannel -> ()
rnf UpdateSmsChannel' {Text
SMSChannelRequest
sMSChannelRequest :: SMSChannelRequest
applicationId :: Text
$sel:sMSChannelRequest:UpdateSmsChannel' :: UpdateSmsChannel -> SMSChannelRequest
$sel:applicationId:UpdateSmsChannel' :: UpdateSmsChannel -> 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 SMSChannelRequest
sMSChannelRequest

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

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

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

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

-- |
-- Create a value of 'UpdateSmsChannelResponse' 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', 'updateSmsChannelResponse_httpStatus' - The response's http status code.
--
-- 'sMSChannelResponse', 'updateSmsChannelResponse_sMSChannelResponse' - Undocumented member.
newUpdateSmsChannelResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  -- | 'sMSChannelResponse'
  SMSChannelResponse ->
  UpdateSmsChannelResponse
newUpdateSmsChannelResponse :: Int -> SMSChannelResponse -> UpdateSmsChannelResponse
newUpdateSmsChannelResponse
  Int
pHttpStatus_
  SMSChannelResponse
pSMSChannelResponse_ =
    UpdateSmsChannelResponse'
      { $sel:httpStatus:UpdateSmsChannelResponse' :: Int
httpStatus =
          Int
pHttpStatus_,
        $sel:sMSChannelResponse:UpdateSmsChannelResponse' :: SMSChannelResponse
sMSChannelResponse = SMSChannelResponse
pSMSChannelResponse_
      }

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

-- | Undocumented member.
updateSmsChannelResponse_sMSChannelResponse :: Lens.Lens' UpdateSmsChannelResponse SMSChannelResponse
updateSmsChannelResponse_sMSChannelResponse :: Lens' UpdateSmsChannelResponse SMSChannelResponse
updateSmsChannelResponse_sMSChannelResponse = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateSmsChannelResponse' {SMSChannelResponse
sMSChannelResponse :: SMSChannelResponse
$sel:sMSChannelResponse:UpdateSmsChannelResponse' :: UpdateSmsChannelResponse -> SMSChannelResponse
sMSChannelResponse} -> SMSChannelResponse
sMSChannelResponse) (\s :: UpdateSmsChannelResponse
s@UpdateSmsChannelResponse' {} SMSChannelResponse
a -> UpdateSmsChannelResponse
s {$sel:sMSChannelResponse:UpdateSmsChannelResponse' :: SMSChannelResponse
sMSChannelResponse = SMSChannelResponse
a} :: UpdateSmsChannelResponse)

instance Prelude.NFData UpdateSmsChannelResponse where
  rnf :: UpdateSmsChannelResponse -> ()
rnf UpdateSmsChannelResponse' {Int
SMSChannelResponse
sMSChannelResponse :: SMSChannelResponse
httpStatus :: Int
$sel:sMSChannelResponse:UpdateSmsChannelResponse' :: UpdateSmsChannelResponse -> SMSChannelResponse
$sel:httpStatus:UpdateSmsChannelResponse' :: UpdateSmsChannelResponse -> 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 SMSChannelResponse
sMSChannelResponse