{-# 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.DeleteSmsChannel
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Disables the SMS channel for an application and deletes any existing
-- settings for the channel.
module Amazonka.Pinpoint.DeleteSmsChannel
  ( -- * Creating a Request
    DeleteSmsChannel (..),
    newDeleteSmsChannel,

    -- * Request Lenses
    deleteSmsChannel_applicationId,

    -- * Destructuring the Response
    DeleteSmsChannelResponse (..),
    newDeleteSmsChannelResponse,

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

-- |
-- Create a value of 'DeleteSmsChannel' 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', 'deleteSmsChannel_applicationId' - The unique identifier for the application. This identifier is displayed
-- as the __Project ID__ on the Amazon Pinpoint console.
newDeleteSmsChannel ::
  -- | 'applicationId'
  Prelude.Text ->
  DeleteSmsChannel
newDeleteSmsChannel :: Text -> DeleteSmsChannel
newDeleteSmsChannel Text
pApplicationId_ =
  DeleteSmsChannel' {$sel:applicationId:DeleteSmsChannel' :: Text
applicationId = Text
pApplicationId_}

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

instance Core.AWSRequest DeleteSmsChannel where
  type
    AWSResponse DeleteSmsChannel =
      DeleteSmsChannelResponse
  request :: (Service -> Service)
-> DeleteSmsChannel -> Request DeleteSmsChannel
request Service -> Service
overrides =
    forall a. ToRequest a => Service -> a -> Request a
Request.delete (Service -> Service
overrides Service
defaultService)
  response :: forall (m :: * -> *).
MonadResource m =>
(ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy DeleteSmsChannel
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse DeleteSmsChannel)))
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 -> DeleteSmsChannelResponse
DeleteSmsChannelResponse'
            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 DeleteSmsChannel where
  hashWithSalt :: Int -> DeleteSmsChannel -> Int
hashWithSalt Int
_salt DeleteSmsChannel' {Text
applicationId :: Text
$sel:applicationId:DeleteSmsChannel' :: DeleteSmsChannel -> Text
..} =
    Int
_salt forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
applicationId

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

instance Data.ToHeaders DeleteSmsChannel where
  toHeaders :: DeleteSmsChannel -> 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.ToPath DeleteSmsChannel where
  toPath :: DeleteSmsChannel -> ByteString
toPath DeleteSmsChannel' {Text
applicationId :: Text
$sel:applicationId:DeleteSmsChannel' :: DeleteSmsChannel -> 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 DeleteSmsChannel where
  toQuery :: DeleteSmsChannel -> QueryString
toQuery = forall a b. a -> b -> a
Prelude.const forall a. Monoid a => a
Prelude.mempty

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

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

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

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

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