{-# 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.SmsVoice.DeleteConfigurationSetEventDestination
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Deletes an event destination in a configuration set.
module Amazonka.SmsVoice.DeleteConfigurationSetEventDestination
  ( -- * Creating a Request
    DeleteConfigurationSetEventDestination (..),
    newDeleteConfigurationSetEventDestination,

    -- * Request Lenses
    deleteConfigurationSetEventDestination_eventDestinationName,
    deleteConfigurationSetEventDestination_configurationSetName,

    -- * Destructuring the Response
    DeleteConfigurationSetEventDestinationResponse (..),
    newDeleteConfigurationSetEventDestinationResponse,

    -- * Response Lenses
    deleteConfigurationSetEventDestinationResponse_httpStatus,
  )
where

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
import Amazonka.SmsVoice.Types

-- | /See:/ 'newDeleteConfigurationSetEventDestination' smart constructor.
data DeleteConfigurationSetEventDestination = DeleteConfigurationSetEventDestination'
  { -- | EventDestinationName
    DeleteConfigurationSetEventDestination -> Text
eventDestinationName :: Prelude.Text,
    -- | ConfigurationSetName
    DeleteConfigurationSetEventDestination -> Text
configurationSetName :: Prelude.Text
  }
  deriving (DeleteConfigurationSetEventDestination
-> DeleteConfigurationSetEventDestination -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DeleteConfigurationSetEventDestination
-> DeleteConfigurationSetEventDestination -> Bool
$c/= :: DeleteConfigurationSetEventDestination
-> DeleteConfigurationSetEventDestination -> Bool
== :: DeleteConfigurationSetEventDestination
-> DeleteConfigurationSetEventDestination -> Bool
$c== :: DeleteConfigurationSetEventDestination
-> DeleteConfigurationSetEventDestination -> Bool
Prelude.Eq, ReadPrec [DeleteConfigurationSetEventDestination]
ReadPrec DeleteConfigurationSetEventDestination
Int -> ReadS DeleteConfigurationSetEventDestination
ReadS [DeleteConfigurationSetEventDestination]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DeleteConfigurationSetEventDestination]
$creadListPrec :: ReadPrec [DeleteConfigurationSetEventDestination]
readPrec :: ReadPrec DeleteConfigurationSetEventDestination
$creadPrec :: ReadPrec DeleteConfigurationSetEventDestination
readList :: ReadS [DeleteConfigurationSetEventDestination]
$creadList :: ReadS [DeleteConfigurationSetEventDestination]
readsPrec :: Int -> ReadS DeleteConfigurationSetEventDestination
$creadsPrec :: Int -> ReadS DeleteConfigurationSetEventDestination
Prelude.Read, Int -> DeleteConfigurationSetEventDestination -> ShowS
[DeleteConfigurationSetEventDestination] -> ShowS
DeleteConfigurationSetEventDestination -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DeleteConfigurationSetEventDestination] -> ShowS
$cshowList :: [DeleteConfigurationSetEventDestination] -> ShowS
show :: DeleteConfigurationSetEventDestination -> String
$cshow :: DeleteConfigurationSetEventDestination -> String
showsPrec :: Int -> DeleteConfigurationSetEventDestination -> ShowS
$cshowsPrec :: Int -> DeleteConfigurationSetEventDestination -> ShowS
Prelude.Show, forall x.
Rep DeleteConfigurationSetEventDestination x
-> DeleteConfigurationSetEventDestination
forall x.
DeleteConfigurationSetEventDestination
-> Rep DeleteConfigurationSetEventDestination x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep DeleteConfigurationSetEventDestination x
-> DeleteConfigurationSetEventDestination
$cfrom :: forall x.
DeleteConfigurationSetEventDestination
-> Rep DeleteConfigurationSetEventDestination x
Prelude.Generic)

-- |
-- Create a value of 'DeleteConfigurationSetEventDestination' 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:
--
-- 'eventDestinationName', 'deleteConfigurationSetEventDestination_eventDestinationName' - EventDestinationName
--
-- 'configurationSetName', 'deleteConfigurationSetEventDestination_configurationSetName' - ConfigurationSetName
newDeleteConfigurationSetEventDestination ::
  -- | 'eventDestinationName'
  Prelude.Text ->
  -- | 'configurationSetName'
  Prelude.Text ->
  DeleteConfigurationSetEventDestination
newDeleteConfigurationSetEventDestination :: Text -> Text -> DeleteConfigurationSetEventDestination
newDeleteConfigurationSetEventDestination
  Text
pEventDestinationName_
  Text
pConfigurationSetName_ =
    DeleteConfigurationSetEventDestination'
      { $sel:eventDestinationName:DeleteConfigurationSetEventDestination' :: Text
eventDestinationName =
          Text
pEventDestinationName_,
        $sel:configurationSetName:DeleteConfigurationSetEventDestination' :: Text
configurationSetName =
          Text
pConfigurationSetName_
      }

-- | EventDestinationName
deleteConfigurationSetEventDestination_eventDestinationName :: Lens.Lens' DeleteConfigurationSetEventDestination Prelude.Text
deleteConfigurationSetEventDestination_eventDestinationName :: Lens' DeleteConfigurationSetEventDestination Text
deleteConfigurationSetEventDestination_eventDestinationName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DeleteConfigurationSetEventDestination' {Text
eventDestinationName :: Text
$sel:eventDestinationName:DeleteConfigurationSetEventDestination' :: DeleteConfigurationSetEventDestination -> Text
eventDestinationName} -> Text
eventDestinationName) (\s :: DeleteConfigurationSetEventDestination
s@DeleteConfigurationSetEventDestination' {} Text
a -> DeleteConfigurationSetEventDestination
s {$sel:eventDestinationName:DeleteConfigurationSetEventDestination' :: Text
eventDestinationName = Text
a} :: DeleteConfigurationSetEventDestination)

-- | ConfigurationSetName
deleteConfigurationSetEventDestination_configurationSetName :: Lens.Lens' DeleteConfigurationSetEventDestination Prelude.Text
deleteConfigurationSetEventDestination_configurationSetName :: Lens' DeleteConfigurationSetEventDestination Text
deleteConfigurationSetEventDestination_configurationSetName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DeleteConfigurationSetEventDestination' {Text
configurationSetName :: Text
$sel:configurationSetName:DeleteConfigurationSetEventDestination' :: DeleteConfigurationSetEventDestination -> Text
configurationSetName} -> Text
configurationSetName) (\s :: DeleteConfigurationSetEventDestination
s@DeleteConfigurationSetEventDestination' {} Text
a -> DeleteConfigurationSetEventDestination
s {$sel:configurationSetName:DeleteConfigurationSetEventDestination' :: Text
configurationSetName = Text
a} :: DeleteConfigurationSetEventDestination)

instance
  Core.AWSRequest
    DeleteConfigurationSetEventDestination
  where
  type
    AWSResponse
      DeleteConfigurationSetEventDestination =
      DeleteConfigurationSetEventDestinationResponse
  request :: (Service -> Service)
-> DeleteConfigurationSetEventDestination
-> Request DeleteConfigurationSetEventDestination
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 DeleteConfigurationSetEventDestination
-> ClientResponse ClientBody
-> m (Either
        Error
        (ClientResponse
           (AWSResponse DeleteConfigurationSetEventDestination)))
response =
    forall (m :: * -> *) a.
MonadResource m =>
(Int -> ResponseHeaders -> () -> Either String (AWSResponse a))
-> (ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy a
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse a)))
Response.receiveEmpty
      ( \Int
s ResponseHeaders
h ()
x ->
          Int -> DeleteConfigurationSetEventDestinationResponse
DeleteConfigurationSetEventDestinationResponse'
            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))
      )

instance
  Prelude.Hashable
    DeleteConfigurationSetEventDestination
  where
  hashWithSalt :: Int -> DeleteConfigurationSetEventDestination -> Int
hashWithSalt
    Int
_salt
    DeleteConfigurationSetEventDestination' {Text
configurationSetName :: Text
eventDestinationName :: Text
$sel:configurationSetName:DeleteConfigurationSetEventDestination' :: DeleteConfigurationSetEventDestination -> Text
$sel:eventDestinationName:DeleteConfigurationSetEventDestination' :: DeleteConfigurationSetEventDestination -> Text
..} =
      Int
_salt
        forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
eventDestinationName
        forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
configurationSetName

instance
  Prelude.NFData
    DeleteConfigurationSetEventDestination
  where
  rnf :: DeleteConfigurationSetEventDestination -> ()
rnf DeleteConfigurationSetEventDestination' {Text
configurationSetName :: Text
eventDestinationName :: Text
$sel:configurationSetName:DeleteConfigurationSetEventDestination' :: DeleteConfigurationSetEventDestination -> Text
$sel:eventDestinationName:DeleteConfigurationSetEventDestination' :: DeleteConfigurationSetEventDestination -> Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Text
eventDestinationName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
configurationSetName

instance
  Data.ToHeaders
    DeleteConfigurationSetEventDestination
  where
  toHeaders :: DeleteConfigurationSetEventDestination -> 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
    DeleteConfigurationSetEventDestination
  where
  toPath :: DeleteConfigurationSetEventDestination -> ByteString
toPath DeleteConfigurationSetEventDestination' {Text
configurationSetName :: Text
eventDestinationName :: Text
$sel:configurationSetName:DeleteConfigurationSetEventDestination' :: DeleteConfigurationSetEventDestination -> Text
$sel:eventDestinationName:DeleteConfigurationSetEventDestination' :: DeleteConfigurationSetEventDestination -> Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"/v1/sms-voice/configuration-sets/",
        forall a. ToByteString a => a -> ByteString
Data.toBS Text
configurationSetName,
        ByteString
"/event-destinations/",
        forall a. ToByteString a => a -> ByteString
Data.toBS Text
eventDestinationName
      ]

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

-- | An empty object that indicates that the event destination was deleted
-- successfully.
--
-- /See:/ 'newDeleteConfigurationSetEventDestinationResponse' smart constructor.
data DeleteConfigurationSetEventDestinationResponse = DeleteConfigurationSetEventDestinationResponse'
  { -- | The response's http status code.
    DeleteConfigurationSetEventDestinationResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (DeleteConfigurationSetEventDestinationResponse
-> DeleteConfigurationSetEventDestinationResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DeleteConfigurationSetEventDestinationResponse
-> DeleteConfigurationSetEventDestinationResponse -> Bool
$c/= :: DeleteConfigurationSetEventDestinationResponse
-> DeleteConfigurationSetEventDestinationResponse -> Bool
== :: DeleteConfigurationSetEventDestinationResponse
-> DeleteConfigurationSetEventDestinationResponse -> Bool
$c== :: DeleteConfigurationSetEventDestinationResponse
-> DeleteConfigurationSetEventDestinationResponse -> Bool
Prelude.Eq, ReadPrec [DeleteConfigurationSetEventDestinationResponse]
ReadPrec DeleteConfigurationSetEventDestinationResponse
Int -> ReadS DeleteConfigurationSetEventDestinationResponse
ReadS [DeleteConfigurationSetEventDestinationResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DeleteConfigurationSetEventDestinationResponse]
$creadListPrec :: ReadPrec [DeleteConfigurationSetEventDestinationResponse]
readPrec :: ReadPrec DeleteConfigurationSetEventDestinationResponse
$creadPrec :: ReadPrec DeleteConfigurationSetEventDestinationResponse
readList :: ReadS [DeleteConfigurationSetEventDestinationResponse]
$creadList :: ReadS [DeleteConfigurationSetEventDestinationResponse]
readsPrec :: Int -> ReadS DeleteConfigurationSetEventDestinationResponse
$creadsPrec :: Int -> ReadS DeleteConfigurationSetEventDestinationResponse
Prelude.Read, Int -> DeleteConfigurationSetEventDestinationResponse -> ShowS
[DeleteConfigurationSetEventDestinationResponse] -> ShowS
DeleteConfigurationSetEventDestinationResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DeleteConfigurationSetEventDestinationResponse] -> ShowS
$cshowList :: [DeleteConfigurationSetEventDestinationResponse] -> ShowS
show :: DeleteConfigurationSetEventDestinationResponse -> String
$cshow :: DeleteConfigurationSetEventDestinationResponse -> String
showsPrec :: Int -> DeleteConfigurationSetEventDestinationResponse -> ShowS
$cshowsPrec :: Int -> DeleteConfigurationSetEventDestinationResponse -> ShowS
Prelude.Show, forall x.
Rep DeleteConfigurationSetEventDestinationResponse x
-> DeleteConfigurationSetEventDestinationResponse
forall x.
DeleteConfigurationSetEventDestinationResponse
-> Rep DeleteConfigurationSetEventDestinationResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep DeleteConfigurationSetEventDestinationResponse x
-> DeleteConfigurationSetEventDestinationResponse
$cfrom :: forall x.
DeleteConfigurationSetEventDestinationResponse
-> Rep DeleteConfigurationSetEventDestinationResponse x
Prelude.Generic)

-- |
-- Create a value of 'DeleteConfigurationSetEventDestinationResponse' 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', 'deleteConfigurationSetEventDestinationResponse_httpStatus' - The response's http status code.
newDeleteConfigurationSetEventDestinationResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  DeleteConfigurationSetEventDestinationResponse
newDeleteConfigurationSetEventDestinationResponse :: Int -> DeleteConfigurationSetEventDestinationResponse
newDeleteConfigurationSetEventDestinationResponse
  Int
pHttpStatus_ =
    DeleteConfigurationSetEventDestinationResponse'
      { $sel:httpStatus:DeleteConfigurationSetEventDestinationResponse' :: Int
httpStatus =
          Int
pHttpStatus_
      }

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

instance
  Prelude.NFData
    DeleteConfigurationSetEventDestinationResponse
  where
  rnf :: DeleteConfigurationSetEventDestinationResponse -> ()
rnf
    DeleteConfigurationSetEventDestinationResponse' {Int
httpStatus :: Int
$sel:httpStatus:DeleteConfigurationSetEventDestinationResponse' :: DeleteConfigurationSetEventDestinationResponse -> Int
..} =
      forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus