{-# 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.CreateSlackChannelConfiguration
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Creates a Slack channel configuration for your Amazon Web Services
-- account.
--
-- -   You can add up to 5 Slack workspaces for your account.
--
-- -   You can add up to 20 Slack channels for your account.
--
-- A Slack channel can have up to 100 Amazon Web Services accounts. This
-- means that only 100 accounts can add the same Slack channel to the
-- Amazon Web Services Support App. We recommend that you only add the
-- accounts that you need to manage support cases for your organization.
-- This can reduce the notifications about case updates that you receive in
-- the Slack channel.
--
-- We recommend that you choose a private Slack channel so that only
-- members in that channel have read and write access to your support
-- cases. Anyone in your Slack channel can create, update, or resolve
-- support cases for your account. Users require an invitation to join
-- private channels.
module Amazonka.SupportApp.CreateSlackChannelConfiguration
  ( -- * Creating a Request
    CreateSlackChannelConfiguration (..),
    newCreateSlackChannelConfiguration,

    -- * Request Lenses
    createSlackChannelConfiguration_channelName,
    createSlackChannelConfiguration_notifyOnAddCorrespondenceToCase,
    createSlackChannelConfiguration_notifyOnCreateOrReopenCase,
    createSlackChannelConfiguration_notifyOnResolveCase,
    createSlackChannelConfiguration_channelId,
    createSlackChannelConfiguration_channelRoleArn,
    createSlackChannelConfiguration_notifyOnCaseSeverity,
    createSlackChannelConfiguration_teamId,

    -- * Destructuring the Response
    CreateSlackChannelConfigurationResponse (..),
    newCreateSlackChannelConfigurationResponse,

    -- * Response Lenses
    createSlackChannelConfigurationResponse_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:/ 'newCreateSlackChannelConfiguration' smart constructor.
data CreateSlackChannelConfiguration = CreateSlackChannelConfiguration'
  { -- | The name of the Slack channel that you configure for the Amazon Web
    -- Services Support App.
    CreateSlackChannelConfiguration -> Maybe Text
channelName :: Prelude.Maybe Prelude.Text,
    -- | Whether you want to get notified when a support case has a new
    -- correspondence.
    CreateSlackChannelConfiguration -> Maybe Bool
notifyOnAddCorrespondenceToCase :: Prelude.Maybe Prelude.Bool,
    -- | Whether you want to get notified when a support case is created or
    -- reopened.
    CreateSlackChannelConfiguration -> Maybe Bool
notifyOnCreateOrReopenCase :: Prelude.Maybe Prelude.Bool,
    -- | Whether you want to get notified when a support case is resolved.
    CreateSlackChannelConfiguration -> Maybe Bool
notifyOnResolveCase :: Prelude.Maybe Prelude.Bool,
    -- | The channel ID in Slack. This ID identifies a channel within a Slack
    -- workspace.
    CreateSlackChannelConfiguration -> Text
channelId :: Prelude.Text,
    -- | The Amazon Resource Name (ARN) of an IAM role that you want to use to
    -- perform operations on Amazon Web Services. For more information, see
    -- <https://docs.aws.amazon.com/awssupport/latest/user/support-app-permissions.html Managing access to the Amazon Web Services Support App>
    -- in the /Amazon Web Services Support User Guide/.
    CreateSlackChannelConfiguration -> Text
channelRoleArn :: Prelude.Text,
    -- | The case severity for a support case that you want to receive
    -- notifications.
    --
    -- If you specify @high@ or @all@, you must specify @true@ for at least one
    -- of the following parameters:
    --
    -- -   @notifyOnAddCorrespondenceToCase@
    --
    -- -   @notifyOnCreateOrReopenCase@
    --
    -- -   @notifyOnResolveCase@
    --
    -- If you specify @none@, the following parameters must be null or @false@:
    --
    -- -   @notifyOnAddCorrespondenceToCase@
    --
    -- -   @notifyOnCreateOrReopenCase@
    --
    -- -   @notifyOnResolveCase@
    --
    -- If you don\'t specify these parameters in your request, they default to
    -- @false@.
    CreateSlackChannelConfiguration -> NotificationSeverityLevel
notifyOnCaseSeverity :: NotificationSeverityLevel,
    -- | The team ID in Slack. This ID uniquely identifies a Slack workspace,
    -- such as @T012ABCDEFG@.
    CreateSlackChannelConfiguration -> Text
teamId :: Prelude.Text
  }
  deriving (CreateSlackChannelConfiguration
-> CreateSlackChannelConfiguration -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateSlackChannelConfiguration
-> CreateSlackChannelConfiguration -> Bool
$c/= :: CreateSlackChannelConfiguration
-> CreateSlackChannelConfiguration -> Bool
== :: CreateSlackChannelConfiguration
-> CreateSlackChannelConfiguration -> Bool
$c== :: CreateSlackChannelConfiguration
-> CreateSlackChannelConfiguration -> Bool
Prelude.Eq, ReadPrec [CreateSlackChannelConfiguration]
ReadPrec CreateSlackChannelConfiguration
Int -> ReadS CreateSlackChannelConfiguration
ReadS [CreateSlackChannelConfiguration]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CreateSlackChannelConfiguration]
$creadListPrec :: ReadPrec [CreateSlackChannelConfiguration]
readPrec :: ReadPrec CreateSlackChannelConfiguration
$creadPrec :: ReadPrec CreateSlackChannelConfiguration
readList :: ReadS [CreateSlackChannelConfiguration]
$creadList :: ReadS [CreateSlackChannelConfiguration]
readsPrec :: Int -> ReadS CreateSlackChannelConfiguration
$creadsPrec :: Int -> ReadS CreateSlackChannelConfiguration
Prelude.Read, Int -> CreateSlackChannelConfiguration -> ShowS
[CreateSlackChannelConfiguration] -> ShowS
CreateSlackChannelConfiguration -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateSlackChannelConfiguration] -> ShowS
$cshowList :: [CreateSlackChannelConfiguration] -> ShowS
show :: CreateSlackChannelConfiguration -> String
$cshow :: CreateSlackChannelConfiguration -> String
showsPrec :: Int -> CreateSlackChannelConfiguration -> ShowS
$cshowsPrec :: Int -> CreateSlackChannelConfiguration -> ShowS
Prelude.Show, forall x.
Rep CreateSlackChannelConfiguration x
-> CreateSlackChannelConfiguration
forall x.
CreateSlackChannelConfiguration
-> Rep CreateSlackChannelConfiguration x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep CreateSlackChannelConfiguration x
-> CreateSlackChannelConfiguration
$cfrom :: forall x.
CreateSlackChannelConfiguration
-> Rep CreateSlackChannelConfiguration x
Prelude.Generic)

-- |
-- Create a value of 'CreateSlackChannelConfiguration' 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:
--
-- 'channelName', 'createSlackChannelConfiguration_channelName' - The name of the Slack channel that you configure for the Amazon Web
-- Services Support App.
--
-- 'notifyOnAddCorrespondenceToCase', 'createSlackChannelConfiguration_notifyOnAddCorrespondenceToCase' - Whether you want to get notified when a support case has a new
-- correspondence.
--
-- 'notifyOnCreateOrReopenCase', 'createSlackChannelConfiguration_notifyOnCreateOrReopenCase' - Whether you want to get notified when a support case is created or
-- reopened.
--
-- 'notifyOnResolveCase', 'createSlackChannelConfiguration_notifyOnResolveCase' - Whether you want to get notified when a support case is resolved.
--
-- 'channelId', 'createSlackChannelConfiguration_channelId' - The channel ID in Slack. This ID identifies a channel within a Slack
-- workspace.
--
-- 'channelRoleArn', 'createSlackChannelConfiguration_channelRoleArn' - The Amazon Resource Name (ARN) of an IAM role that you want to use to
-- perform operations on Amazon Web Services. For more information, see
-- <https://docs.aws.amazon.com/awssupport/latest/user/support-app-permissions.html Managing access to the Amazon Web Services Support App>
-- in the /Amazon Web Services Support User Guide/.
--
-- 'notifyOnCaseSeverity', 'createSlackChannelConfiguration_notifyOnCaseSeverity' - The case severity for a support case that you want to receive
-- notifications.
--
-- If you specify @high@ or @all@, you must specify @true@ for at least one
-- of the following parameters:
--
-- -   @notifyOnAddCorrespondenceToCase@
--
-- -   @notifyOnCreateOrReopenCase@
--
-- -   @notifyOnResolveCase@
--
-- If you specify @none@, the following parameters must be null or @false@:
--
-- -   @notifyOnAddCorrespondenceToCase@
--
-- -   @notifyOnCreateOrReopenCase@
--
-- -   @notifyOnResolveCase@
--
-- If you don\'t specify these parameters in your request, they default to
-- @false@.
--
-- 'teamId', 'createSlackChannelConfiguration_teamId' - The team ID in Slack. This ID uniquely identifies a Slack workspace,
-- such as @T012ABCDEFG@.
newCreateSlackChannelConfiguration ::
  -- | 'channelId'
  Prelude.Text ->
  -- | 'channelRoleArn'
  Prelude.Text ->
  -- | 'notifyOnCaseSeverity'
  NotificationSeverityLevel ->
  -- | 'teamId'
  Prelude.Text ->
  CreateSlackChannelConfiguration
newCreateSlackChannelConfiguration :: Text
-> Text
-> NotificationSeverityLevel
-> Text
-> CreateSlackChannelConfiguration
newCreateSlackChannelConfiguration
  Text
pChannelId_
  Text
pChannelRoleArn_
  NotificationSeverityLevel
pNotifyOnCaseSeverity_
  Text
pTeamId_ =
    CreateSlackChannelConfiguration'
      { $sel:channelName:CreateSlackChannelConfiguration' :: Maybe Text
channelName =
          forall a. Maybe a
Prelude.Nothing,
        $sel:notifyOnAddCorrespondenceToCase:CreateSlackChannelConfiguration' :: Maybe Bool
notifyOnAddCorrespondenceToCase =
          forall a. Maybe a
Prelude.Nothing,
        $sel:notifyOnCreateOrReopenCase:CreateSlackChannelConfiguration' :: Maybe Bool
notifyOnCreateOrReopenCase =
          forall a. Maybe a
Prelude.Nothing,
        $sel:notifyOnResolveCase:CreateSlackChannelConfiguration' :: Maybe Bool
notifyOnResolveCase = forall a. Maybe a
Prelude.Nothing,
        $sel:channelId:CreateSlackChannelConfiguration' :: Text
channelId = Text
pChannelId_,
        $sel:channelRoleArn:CreateSlackChannelConfiguration' :: Text
channelRoleArn = Text
pChannelRoleArn_,
        $sel:notifyOnCaseSeverity:CreateSlackChannelConfiguration' :: NotificationSeverityLevel
notifyOnCaseSeverity =
          NotificationSeverityLevel
pNotifyOnCaseSeverity_,
        $sel:teamId:CreateSlackChannelConfiguration' :: Text
teamId = Text
pTeamId_
      }

-- | The name of the Slack channel that you configure for the Amazon Web
-- Services Support App.
createSlackChannelConfiguration_channelName :: Lens.Lens' CreateSlackChannelConfiguration (Prelude.Maybe Prelude.Text)
createSlackChannelConfiguration_channelName :: Lens' CreateSlackChannelConfiguration (Maybe Text)
createSlackChannelConfiguration_channelName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateSlackChannelConfiguration' {Maybe Text
channelName :: Maybe Text
$sel:channelName:CreateSlackChannelConfiguration' :: CreateSlackChannelConfiguration -> Maybe Text
channelName} -> Maybe Text
channelName) (\s :: CreateSlackChannelConfiguration
s@CreateSlackChannelConfiguration' {} Maybe Text
a -> CreateSlackChannelConfiguration
s {$sel:channelName:CreateSlackChannelConfiguration' :: Maybe Text
channelName = Maybe Text
a} :: CreateSlackChannelConfiguration)

-- | Whether you want to get notified when a support case has a new
-- correspondence.
createSlackChannelConfiguration_notifyOnAddCorrespondenceToCase :: Lens.Lens' CreateSlackChannelConfiguration (Prelude.Maybe Prelude.Bool)
createSlackChannelConfiguration_notifyOnAddCorrespondenceToCase :: Lens' CreateSlackChannelConfiguration (Maybe Bool)
createSlackChannelConfiguration_notifyOnAddCorrespondenceToCase = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateSlackChannelConfiguration' {Maybe Bool
notifyOnAddCorrespondenceToCase :: Maybe Bool
$sel:notifyOnAddCorrespondenceToCase:CreateSlackChannelConfiguration' :: CreateSlackChannelConfiguration -> Maybe Bool
notifyOnAddCorrespondenceToCase} -> Maybe Bool
notifyOnAddCorrespondenceToCase) (\s :: CreateSlackChannelConfiguration
s@CreateSlackChannelConfiguration' {} Maybe Bool
a -> CreateSlackChannelConfiguration
s {$sel:notifyOnAddCorrespondenceToCase:CreateSlackChannelConfiguration' :: Maybe Bool
notifyOnAddCorrespondenceToCase = Maybe Bool
a} :: CreateSlackChannelConfiguration)

-- | Whether you want to get notified when a support case is created or
-- reopened.
createSlackChannelConfiguration_notifyOnCreateOrReopenCase :: Lens.Lens' CreateSlackChannelConfiguration (Prelude.Maybe Prelude.Bool)
createSlackChannelConfiguration_notifyOnCreateOrReopenCase :: Lens' CreateSlackChannelConfiguration (Maybe Bool)
createSlackChannelConfiguration_notifyOnCreateOrReopenCase = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateSlackChannelConfiguration' {Maybe Bool
notifyOnCreateOrReopenCase :: Maybe Bool
$sel:notifyOnCreateOrReopenCase:CreateSlackChannelConfiguration' :: CreateSlackChannelConfiguration -> Maybe Bool
notifyOnCreateOrReopenCase} -> Maybe Bool
notifyOnCreateOrReopenCase) (\s :: CreateSlackChannelConfiguration
s@CreateSlackChannelConfiguration' {} Maybe Bool
a -> CreateSlackChannelConfiguration
s {$sel:notifyOnCreateOrReopenCase:CreateSlackChannelConfiguration' :: Maybe Bool
notifyOnCreateOrReopenCase = Maybe Bool
a} :: CreateSlackChannelConfiguration)

-- | Whether you want to get notified when a support case is resolved.
createSlackChannelConfiguration_notifyOnResolveCase :: Lens.Lens' CreateSlackChannelConfiguration (Prelude.Maybe Prelude.Bool)
createSlackChannelConfiguration_notifyOnResolveCase :: Lens' CreateSlackChannelConfiguration (Maybe Bool)
createSlackChannelConfiguration_notifyOnResolveCase = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateSlackChannelConfiguration' {Maybe Bool
notifyOnResolveCase :: Maybe Bool
$sel:notifyOnResolveCase:CreateSlackChannelConfiguration' :: CreateSlackChannelConfiguration -> Maybe Bool
notifyOnResolveCase} -> Maybe Bool
notifyOnResolveCase) (\s :: CreateSlackChannelConfiguration
s@CreateSlackChannelConfiguration' {} Maybe Bool
a -> CreateSlackChannelConfiguration
s {$sel:notifyOnResolveCase:CreateSlackChannelConfiguration' :: Maybe Bool
notifyOnResolveCase = Maybe Bool
a} :: CreateSlackChannelConfiguration)

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

-- | The Amazon Resource Name (ARN) of an IAM role that you want to use to
-- perform operations on Amazon Web Services. For more information, see
-- <https://docs.aws.amazon.com/awssupport/latest/user/support-app-permissions.html Managing access to the Amazon Web Services Support App>
-- in the /Amazon Web Services Support User Guide/.
createSlackChannelConfiguration_channelRoleArn :: Lens.Lens' CreateSlackChannelConfiguration Prelude.Text
createSlackChannelConfiguration_channelRoleArn :: Lens' CreateSlackChannelConfiguration Text
createSlackChannelConfiguration_channelRoleArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateSlackChannelConfiguration' {Text
channelRoleArn :: Text
$sel:channelRoleArn:CreateSlackChannelConfiguration' :: CreateSlackChannelConfiguration -> Text
channelRoleArn} -> Text
channelRoleArn) (\s :: CreateSlackChannelConfiguration
s@CreateSlackChannelConfiguration' {} Text
a -> CreateSlackChannelConfiguration
s {$sel:channelRoleArn:CreateSlackChannelConfiguration' :: Text
channelRoleArn = Text
a} :: CreateSlackChannelConfiguration)

-- | The case severity for a support case that you want to receive
-- notifications.
--
-- If you specify @high@ or @all@, you must specify @true@ for at least one
-- of the following parameters:
--
-- -   @notifyOnAddCorrespondenceToCase@
--
-- -   @notifyOnCreateOrReopenCase@
--
-- -   @notifyOnResolveCase@
--
-- If you specify @none@, the following parameters must be null or @false@:
--
-- -   @notifyOnAddCorrespondenceToCase@
--
-- -   @notifyOnCreateOrReopenCase@
--
-- -   @notifyOnResolveCase@
--
-- If you don\'t specify these parameters in your request, they default to
-- @false@.
createSlackChannelConfiguration_notifyOnCaseSeverity :: Lens.Lens' CreateSlackChannelConfiguration NotificationSeverityLevel
createSlackChannelConfiguration_notifyOnCaseSeverity :: Lens' CreateSlackChannelConfiguration NotificationSeverityLevel
createSlackChannelConfiguration_notifyOnCaseSeverity = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateSlackChannelConfiguration' {NotificationSeverityLevel
notifyOnCaseSeverity :: NotificationSeverityLevel
$sel:notifyOnCaseSeverity:CreateSlackChannelConfiguration' :: CreateSlackChannelConfiguration -> NotificationSeverityLevel
notifyOnCaseSeverity} -> NotificationSeverityLevel
notifyOnCaseSeverity) (\s :: CreateSlackChannelConfiguration
s@CreateSlackChannelConfiguration' {} NotificationSeverityLevel
a -> CreateSlackChannelConfiguration
s {$sel:notifyOnCaseSeverity:CreateSlackChannelConfiguration' :: NotificationSeverityLevel
notifyOnCaseSeverity = NotificationSeverityLevel
a} :: CreateSlackChannelConfiguration)

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

instance
  Core.AWSRequest
    CreateSlackChannelConfiguration
  where
  type
    AWSResponse CreateSlackChannelConfiguration =
      CreateSlackChannelConfigurationResponse
  request :: (Service -> Service)
-> CreateSlackChannelConfiguration
-> Request CreateSlackChannelConfiguration
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 CreateSlackChannelConfiguration
-> ClientResponse ClientBody
-> m (Either
        Error
        (ClientResponse (AWSResponse CreateSlackChannelConfiguration)))
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 -> CreateSlackChannelConfigurationResponse
CreateSlackChannelConfigurationResponse'
            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
    CreateSlackChannelConfiguration
  where
  hashWithSalt :: Int -> CreateSlackChannelConfiguration -> Int
hashWithSalt
    Int
_salt
    CreateSlackChannelConfiguration' {Maybe Bool
Maybe Text
Text
NotificationSeverityLevel
teamId :: Text
notifyOnCaseSeverity :: NotificationSeverityLevel
channelRoleArn :: Text
channelId :: Text
notifyOnResolveCase :: Maybe Bool
notifyOnCreateOrReopenCase :: Maybe Bool
notifyOnAddCorrespondenceToCase :: Maybe Bool
channelName :: Maybe Text
$sel:teamId:CreateSlackChannelConfiguration' :: CreateSlackChannelConfiguration -> Text
$sel:notifyOnCaseSeverity:CreateSlackChannelConfiguration' :: CreateSlackChannelConfiguration -> NotificationSeverityLevel
$sel:channelRoleArn:CreateSlackChannelConfiguration' :: CreateSlackChannelConfiguration -> Text
$sel:channelId:CreateSlackChannelConfiguration' :: CreateSlackChannelConfiguration -> Text
$sel:notifyOnResolveCase:CreateSlackChannelConfiguration' :: CreateSlackChannelConfiguration -> Maybe Bool
$sel:notifyOnCreateOrReopenCase:CreateSlackChannelConfiguration' :: CreateSlackChannelConfiguration -> Maybe Bool
$sel:notifyOnAddCorrespondenceToCase:CreateSlackChannelConfiguration' :: CreateSlackChannelConfiguration -> Maybe Bool
$sel:channelName:CreateSlackChannelConfiguration' :: CreateSlackChannelConfiguration -> Maybe Text
..} =
      Int
_salt
        forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
channelName
        forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Bool
notifyOnAddCorrespondenceToCase
        forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Bool
notifyOnCreateOrReopenCase
        forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Bool
notifyOnResolveCase
        forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
channelId
        forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
channelRoleArn
        forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` NotificationSeverityLevel
notifyOnCaseSeverity
        forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
teamId

instance
  Prelude.NFData
    CreateSlackChannelConfiguration
  where
  rnf :: CreateSlackChannelConfiguration -> ()
rnf CreateSlackChannelConfiguration' {Maybe Bool
Maybe Text
Text
NotificationSeverityLevel
teamId :: Text
notifyOnCaseSeverity :: NotificationSeverityLevel
channelRoleArn :: Text
channelId :: Text
notifyOnResolveCase :: Maybe Bool
notifyOnCreateOrReopenCase :: Maybe Bool
notifyOnAddCorrespondenceToCase :: Maybe Bool
channelName :: Maybe Text
$sel:teamId:CreateSlackChannelConfiguration' :: CreateSlackChannelConfiguration -> Text
$sel:notifyOnCaseSeverity:CreateSlackChannelConfiguration' :: CreateSlackChannelConfiguration -> NotificationSeverityLevel
$sel:channelRoleArn:CreateSlackChannelConfiguration' :: CreateSlackChannelConfiguration -> Text
$sel:channelId:CreateSlackChannelConfiguration' :: CreateSlackChannelConfiguration -> Text
$sel:notifyOnResolveCase:CreateSlackChannelConfiguration' :: CreateSlackChannelConfiguration -> Maybe Bool
$sel:notifyOnCreateOrReopenCase:CreateSlackChannelConfiguration' :: CreateSlackChannelConfiguration -> Maybe Bool
$sel:notifyOnAddCorrespondenceToCase:CreateSlackChannelConfiguration' :: CreateSlackChannelConfiguration -> Maybe Bool
$sel:channelName:CreateSlackChannelConfiguration' :: CreateSlackChannelConfiguration -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
channelName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Bool
notifyOnAddCorrespondenceToCase
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Bool
notifyOnCreateOrReopenCase
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Bool
notifyOnResolveCase
      seq :: forall a b. a -> b -> b
`Prelude.seq` 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
channelRoleArn
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf NotificationSeverityLevel
notifyOnCaseSeverity
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
teamId

instance
  Data.ToHeaders
    CreateSlackChannelConfiguration
  where
  toHeaders :: CreateSlackChannelConfiguration -> 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 CreateSlackChannelConfiguration where
  toJSON :: CreateSlackChannelConfiguration -> Value
toJSON CreateSlackChannelConfiguration' {Maybe Bool
Maybe Text
Text
NotificationSeverityLevel
teamId :: Text
notifyOnCaseSeverity :: NotificationSeverityLevel
channelRoleArn :: Text
channelId :: Text
notifyOnResolveCase :: Maybe Bool
notifyOnCreateOrReopenCase :: Maybe Bool
notifyOnAddCorrespondenceToCase :: Maybe Bool
channelName :: Maybe Text
$sel:teamId:CreateSlackChannelConfiguration' :: CreateSlackChannelConfiguration -> Text
$sel:notifyOnCaseSeverity:CreateSlackChannelConfiguration' :: CreateSlackChannelConfiguration -> NotificationSeverityLevel
$sel:channelRoleArn:CreateSlackChannelConfiguration' :: CreateSlackChannelConfiguration -> Text
$sel:channelId:CreateSlackChannelConfiguration' :: CreateSlackChannelConfiguration -> Text
$sel:notifyOnResolveCase:CreateSlackChannelConfiguration' :: CreateSlackChannelConfiguration -> Maybe Bool
$sel:notifyOnCreateOrReopenCase:CreateSlackChannelConfiguration' :: CreateSlackChannelConfiguration -> Maybe Bool
$sel:notifyOnAddCorrespondenceToCase:CreateSlackChannelConfiguration' :: CreateSlackChannelConfiguration -> Maybe Bool
$sel:channelName:CreateSlackChannelConfiguration' :: CreateSlackChannelConfiguration -> Maybe Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"channelName" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe Text
channelName,
            (Key
"notifyOnAddCorrespondenceToCase" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=)
              forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe Bool
notifyOnAddCorrespondenceToCase,
            (Key
"notifyOnCreateOrReopenCase" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=)
              forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe Bool
notifyOnCreateOrReopenCase,
            (Key
"notifyOnResolveCase" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=)
              forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe Bool
notifyOnResolveCase,
            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
"channelRoleArn" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
channelRoleArn),
            forall a. a -> Maybe a
Prelude.Just
              ( Key
"notifyOnCaseSeverity"
                  forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= NotificationSeverityLevel
notifyOnCaseSeverity
              ),
            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 CreateSlackChannelConfiguration where
  toPath :: CreateSlackChannelConfiguration -> ByteString
toPath =
    forall a b. a -> b -> a
Prelude.const
      ByteString
"/control/create-slack-channel-configuration"

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

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

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

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

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