{-# 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.DeleteApnsVoipChannel
-- 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 APNs VoIP channel for an application and deletes any
-- existing settings for the channel.
module Amazonka.Pinpoint.DeleteApnsVoipChannel
  ( -- * Creating a Request
    DeleteApnsVoipChannel (..),
    newDeleteApnsVoipChannel,

    -- * Request Lenses
    deleteApnsVoipChannel_applicationId,

    -- * Destructuring the Response
    DeleteApnsVoipChannelResponse (..),
    newDeleteApnsVoipChannelResponse,

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

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

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

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

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

instance Data.ToHeaders DeleteApnsVoipChannel where
  toHeaders :: DeleteApnsVoipChannel -> 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 DeleteApnsVoipChannel where
  toPath :: DeleteApnsVoipChannel -> ByteString
toPath DeleteApnsVoipChannel' {Text
applicationId :: Text
$sel:applicationId:DeleteApnsVoipChannel' :: DeleteApnsVoipChannel -> Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"/v1/apps/",
        forall a. ToByteString a => a -> ByteString
Data.toBS Text
applicationId,
        ByteString
"/channels/apns_voip"
      ]

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

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

-- |
-- Create a value of 'DeleteApnsVoipChannelResponse' 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', 'deleteApnsVoipChannelResponse_httpStatus' - The response's http status code.
--
-- 'aPNSVoipChannelResponse', 'deleteApnsVoipChannelResponse_aPNSVoipChannelResponse' - Undocumented member.
newDeleteApnsVoipChannelResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  -- | 'aPNSVoipChannelResponse'
  APNSVoipChannelResponse ->
  DeleteApnsVoipChannelResponse
newDeleteApnsVoipChannelResponse :: Int -> APNSVoipChannelResponse -> DeleteApnsVoipChannelResponse
newDeleteApnsVoipChannelResponse
  Int
pHttpStatus_
  APNSVoipChannelResponse
pAPNSVoipChannelResponse_ =
    DeleteApnsVoipChannelResponse'
      { $sel:httpStatus:DeleteApnsVoipChannelResponse' :: Int
httpStatus =
          Int
pHttpStatus_,
        $sel:aPNSVoipChannelResponse:DeleteApnsVoipChannelResponse' :: APNSVoipChannelResponse
aPNSVoipChannelResponse =
          APNSVoipChannelResponse
pAPNSVoipChannelResponse_
      }

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

-- | Undocumented member.
deleteApnsVoipChannelResponse_aPNSVoipChannelResponse :: Lens.Lens' DeleteApnsVoipChannelResponse APNSVoipChannelResponse
deleteApnsVoipChannelResponse_aPNSVoipChannelResponse :: Lens' DeleteApnsVoipChannelResponse APNSVoipChannelResponse
deleteApnsVoipChannelResponse_aPNSVoipChannelResponse = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DeleteApnsVoipChannelResponse' {APNSVoipChannelResponse
aPNSVoipChannelResponse :: APNSVoipChannelResponse
$sel:aPNSVoipChannelResponse:DeleteApnsVoipChannelResponse' :: DeleteApnsVoipChannelResponse -> APNSVoipChannelResponse
aPNSVoipChannelResponse} -> APNSVoipChannelResponse
aPNSVoipChannelResponse) (\s :: DeleteApnsVoipChannelResponse
s@DeleteApnsVoipChannelResponse' {} APNSVoipChannelResponse
a -> DeleteApnsVoipChannelResponse
s {$sel:aPNSVoipChannelResponse:DeleteApnsVoipChannelResponse' :: APNSVoipChannelResponse
aPNSVoipChannelResponse = APNSVoipChannelResponse
a} :: DeleteApnsVoipChannelResponse)

instance Prelude.NFData DeleteApnsVoipChannelResponse where
  rnf :: DeleteApnsVoipChannelResponse -> ()
rnf DeleteApnsVoipChannelResponse' {Int
APNSVoipChannelResponse
aPNSVoipChannelResponse :: APNSVoipChannelResponse
httpStatus :: Int
$sel:aPNSVoipChannelResponse:DeleteApnsVoipChannelResponse' :: DeleteApnsVoipChannelResponse -> APNSVoipChannelResponse
$sel:httpStatus:DeleteApnsVoipChannelResponse' :: DeleteApnsVoipChannelResponse -> 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 APNSVoipChannelResponse
aPNSVoipChannelResponse