{-# 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.SupportApp.DeleteSlackChannelConfiguration
-- 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 a Slack channel configuration from your Amazon Web Services
-- account. This operation doesn\'t delete your Slack channel.
module Amazonka.SupportApp.DeleteSlackChannelConfiguration
  ( -- * Creating a Request
    DeleteSlackChannelConfiguration (..),
    newDeleteSlackChannelConfiguration,

    -- * Request Lenses
    deleteSlackChannelConfiguration_channelId,
    deleteSlackChannelConfiguration_teamId,

    -- * Destructuring the Response
    DeleteSlackChannelConfigurationResponse (..),
    newDeleteSlackChannelConfigurationResponse,

    -- * Response Lenses
    deleteSlackChannelConfigurationResponse_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.SupportApp.Types

-- | /See:/ 'newDeleteSlackChannelConfiguration' smart constructor.
data DeleteSlackChannelConfiguration = DeleteSlackChannelConfiguration'
  { -- | The channel ID in Slack. This ID identifies a channel within a Slack
    -- workspace.
    DeleteSlackChannelConfiguration -> Text
channelId :: Prelude.Text,
    -- | The team ID in Slack. This ID uniquely identifies a Slack workspace,
    -- such as @T012ABCDEFG@.
    DeleteSlackChannelConfiguration -> Text
teamId :: Prelude.Text
  }
  deriving (DeleteSlackChannelConfiguration
-> DeleteSlackChannelConfiguration -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DeleteSlackChannelConfiguration
-> DeleteSlackChannelConfiguration -> Bool
$c/= :: DeleteSlackChannelConfiguration
-> DeleteSlackChannelConfiguration -> Bool
== :: DeleteSlackChannelConfiguration
-> DeleteSlackChannelConfiguration -> Bool
$c== :: DeleteSlackChannelConfiguration
-> DeleteSlackChannelConfiguration -> Bool
Prelude.Eq, ReadPrec [DeleteSlackChannelConfiguration]
ReadPrec DeleteSlackChannelConfiguration
Int -> ReadS DeleteSlackChannelConfiguration
ReadS [DeleteSlackChannelConfiguration]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DeleteSlackChannelConfiguration]
$creadListPrec :: ReadPrec [DeleteSlackChannelConfiguration]
readPrec :: ReadPrec DeleteSlackChannelConfiguration
$creadPrec :: ReadPrec DeleteSlackChannelConfiguration
readList :: ReadS [DeleteSlackChannelConfiguration]
$creadList :: ReadS [DeleteSlackChannelConfiguration]
readsPrec :: Int -> ReadS DeleteSlackChannelConfiguration
$creadsPrec :: Int -> ReadS DeleteSlackChannelConfiguration
Prelude.Read, Int -> DeleteSlackChannelConfiguration -> ShowS
[DeleteSlackChannelConfiguration] -> ShowS
DeleteSlackChannelConfiguration -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DeleteSlackChannelConfiguration] -> ShowS
$cshowList :: [DeleteSlackChannelConfiguration] -> ShowS
show :: DeleteSlackChannelConfiguration -> String
$cshow :: DeleteSlackChannelConfiguration -> String
showsPrec :: Int -> DeleteSlackChannelConfiguration -> ShowS
$cshowsPrec :: Int -> DeleteSlackChannelConfiguration -> ShowS
Prelude.Show, forall x.
Rep DeleteSlackChannelConfiguration x
-> DeleteSlackChannelConfiguration
forall x.
DeleteSlackChannelConfiguration
-> Rep DeleteSlackChannelConfiguration x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep DeleteSlackChannelConfiguration x
-> DeleteSlackChannelConfiguration
$cfrom :: forall x.
DeleteSlackChannelConfiguration
-> Rep DeleteSlackChannelConfiguration x
Prelude.Generic)

-- |
-- Create a value of 'DeleteSlackChannelConfiguration' 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:
--
-- 'channelId', 'deleteSlackChannelConfiguration_channelId' - The channel ID in Slack. This ID identifies a channel within a Slack
-- workspace.
--
-- 'teamId', 'deleteSlackChannelConfiguration_teamId' - The team ID in Slack. This ID uniquely identifies a Slack workspace,
-- such as @T012ABCDEFG@.
newDeleteSlackChannelConfiguration ::
  -- | 'channelId'
  Prelude.Text ->
  -- | 'teamId'
  Prelude.Text ->
  DeleteSlackChannelConfiguration
newDeleteSlackChannelConfiguration :: Text -> Text -> DeleteSlackChannelConfiguration
newDeleteSlackChannelConfiguration
  Text
pChannelId_
  Text
pTeamId_ =
    DeleteSlackChannelConfiguration'
      { $sel:channelId:DeleteSlackChannelConfiguration' :: Text
channelId =
          Text
pChannelId_,
        $sel:teamId:DeleteSlackChannelConfiguration' :: Text
teamId = Text
pTeamId_
      }

-- | The channel ID in Slack. This ID identifies a channel within a Slack
-- workspace.
deleteSlackChannelConfiguration_channelId :: Lens.Lens' DeleteSlackChannelConfiguration Prelude.Text
deleteSlackChannelConfiguration_channelId :: Lens' DeleteSlackChannelConfiguration Text
deleteSlackChannelConfiguration_channelId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DeleteSlackChannelConfiguration' {Text
channelId :: Text
$sel:channelId:DeleteSlackChannelConfiguration' :: DeleteSlackChannelConfiguration -> Text
channelId} -> Text
channelId) (\s :: DeleteSlackChannelConfiguration
s@DeleteSlackChannelConfiguration' {} Text
a -> DeleteSlackChannelConfiguration
s {$sel:channelId:DeleteSlackChannelConfiguration' :: Text
channelId = Text
a} :: DeleteSlackChannelConfiguration)

-- | The team ID in Slack. This ID uniquely identifies a Slack workspace,
-- such as @T012ABCDEFG@.
deleteSlackChannelConfiguration_teamId :: Lens.Lens' DeleteSlackChannelConfiguration Prelude.Text
deleteSlackChannelConfiguration_teamId :: Lens' DeleteSlackChannelConfiguration Text
deleteSlackChannelConfiguration_teamId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DeleteSlackChannelConfiguration' {Text
teamId :: Text
$sel:teamId:DeleteSlackChannelConfiguration' :: DeleteSlackChannelConfiguration -> Text
teamId} -> Text
teamId) (\s :: DeleteSlackChannelConfiguration
s@DeleteSlackChannelConfiguration' {} Text
a -> DeleteSlackChannelConfiguration
s {$sel:teamId:DeleteSlackChannelConfiguration' :: Text
teamId = Text
a} :: DeleteSlackChannelConfiguration)

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

instance
  Prelude.NFData
    DeleteSlackChannelConfiguration
  where
  rnf :: DeleteSlackChannelConfiguration -> ()
rnf DeleteSlackChannelConfiguration' {Text
teamId :: Text
channelId :: Text
$sel:teamId:DeleteSlackChannelConfiguration' :: DeleteSlackChannelConfiguration -> Text
$sel:channelId:DeleteSlackChannelConfiguration' :: DeleteSlackChannelConfiguration -> Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Text
channelId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
teamId

instance
  Data.ToHeaders
    DeleteSlackChannelConfiguration
  where
  toHeaders :: DeleteSlackChannelConfiguration -> 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 DeleteSlackChannelConfiguration where
  toJSON :: DeleteSlackChannelConfiguration -> Value
toJSON DeleteSlackChannelConfiguration' {Text
teamId :: Text
channelId :: Text
$sel:teamId:DeleteSlackChannelConfiguration' :: DeleteSlackChannelConfiguration -> Text
$sel:channelId:DeleteSlackChannelConfiguration' :: DeleteSlackChannelConfiguration -> Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ forall a. a -> Maybe a
Prelude.Just (Key
"channelId" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
channelId),
            forall a. a -> Maybe a
Prelude.Just (Key
"teamId" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
teamId)
          ]
      )

instance Data.ToPath DeleteSlackChannelConfiguration where
  toPath :: DeleteSlackChannelConfiguration -> ByteString
toPath =
    forall a b. a -> b -> a
Prelude.const
      ByteString
"/control/delete-slack-channel-configuration"

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

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

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

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

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