{-# 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.UpdateSlackChannelConfiguration
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Updates the configuration for a Slack channel, such as case update
-- notifications.
module Amazonka.SupportApp.UpdateSlackChannelConfiguration
  ( -- * Creating a Request
    UpdateSlackChannelConfiguration (..),
    newUpdateSlackChannelConfiguration,

    -- * Request Lenses
    updateSlackChannelConfiguration_channelName,
    updateSlackChannelConfiguration_channelRoleArn,
    updateSlackChannelConfiguration_notifyOnAddCorrespondenceToCase,
    updateSlackChannelConfiguration_notifyOnCaseSeverity,
    updateSlackChannelConfiguration_notifyOnCreateOrReopenCase,
    updateSlackChannelConfiguration_notifyOnResolveCase,
    updateSlackChannelConfiguration_channelId,
    updateSlackChannelConfiguration_teamId,

    -- * Destructuring the Response
    UpdateSlackChannelConfigurationResponse (..),
    newUpdateSlackChannelConfigurationResponse,

    -- * Response Lenses
    updateSlackChannelConfigurationResponse_channelId,
    updateSlackChannelConfigurationResponse_channelName,
    updateSlackChannelConfigurationResponse_channelRoleArn,
    updateSlackChannelConfigurationResponse_notifyOnAddCorrespondenceToCase,
    updateSlackChannelConfigurationResponse_notifyOnCaseSeverity,
    updateSlackChannelConfigurationResponse_notifyOnCreateOrReopenCase,
    updateSlackChannelConfigurationResponse_notifyOnResolveCase,
    updateSlackChannelConfigurationResponse_teamId,
    updateSlackChannelConfigurationResponse_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:/ 'newUpdateSlackChannelConfiguration' smart constructor.
data UpdateSlackChannelConfiguration = UpdateSlackChannelConfiguration'
  { -- | The Slack channel name that you want to update.
    UpdateSlackChannelConfiguration -> Maybe Text
channelName :: Prelude.Maybe 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/.
    UpdateSlackChannelConfiguration -> Maybe Text
channelRoleArn :: Prelude.Maybe Prelude.Text,
    -- | Whether you want to get notified when a support case has a new
    -- correspondence.
    UpdateSlackChannelConfiguration -> Maybe Bool
notifyOnAddCorrespondenceToCase :: Prelude.Maybe Prelude.Bool,
    -- | The case severity for a support case that you want to receive
    -- notifications.
    --
    -- If you specify @high@ or @all@, at least one of the following parameters
    -- must be @true@:
    --
    -- -   @notifyOnAddCorrespondenceToCase@
    --
    -- -   @notifyOnCreateOrReopenCase@
    --
    -- -   @notifyOnResolveCase@
    --
    -- If you specify @none@, any of the following parameters that you specify
    -- in your request must be @false@:
    --
    -- -   @notifyOnAddCorrespondenceToCase@
    --
    -- -   @notifyOnCreateOrReopenCase@
    --
    -- -   @notifyOnResolveCase@
    --
    -- If you don\'t specify these parameters in your request, the Amazon Web
    -- Services Support App uses the current values by default.
    UpdateSlackChannelConfiguration -> Maybe NotificationSeverityLevel
notifyOnCaseSeverity :: Prelude.Maybe NotificationSeverityLevel,
    -- | Whether you want to get notified when a support case is created or
    -- reopened.
    UpdateSlackChannelConfiguration -> Maybe Bool
notifyOnCreateOrReopenCase :: Prelude.Maybe Prelude.Bool,
    -- | Whether you want to get notified when a support case is resolved.
    UpdateSlackChannelConfiguration -> Maybe Bool
notifyOnResolveCase :: Prelude.Maybe Prelude.Bool,
    -- | The channel ID in Slack. This ID identifies a channel within a Slack
    -- workspace.
    UpdateSlackChannelConfiguration -> Text
channelId :: Prelude.Text,
    -- | The team ID in Slack. This ID uniquely identifies a Slack workspace,
    -- such as @T012ABCDEFG@.
    UpdateSlackChannelConfiguration -> Text
teamId :: Prelude.Text
  }
  deriving (UpdateSlackChannelConfiguration
-> UpdateSlackChannelConfiguration -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UpdateSlackChannelConfiguration
-> UpdateSlackChannelConfiguration -> Bool
$c/= :: UpdateSlackChannelConfiguration
-> UpdateSlackChannelConfiguration -> Bool
== :: UpdateSlackChannelConfiguration
-> UpdateSlackChannelConfiguration -> Bool
$c== :: UpdateSlackChannelConfiguration
-> UpdateSlackChannelConfiguration -> Bool
Prelude.Eq, ReadPrec [UpdateSlackChannelConfiguration]
ReadPrec UpdateSlackChannelConfiguration
Int -> ReadS UpdateSlackChannelConfiguration
ReadS [UpdateSlackChannelConfiguration]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [UpdateSlackChannelConfiguration]
$creadListPrec :: ReadPrec [UpdateSlackChannelConfiguration]
readPrec :: ReadPrec UpdateSlackChannelConfiguration
$creadPrec :: ReadPrec UpdateSlackChannelConfiguration
readList :: ReadS [UpdateSlackChannelConfiguration]
$creadList :: ReadS [UpdateSlackChannelConfiguration]
readsPrec :: Int -> ReadS UpdateSlackChannelConfiguration
$creadsPrec :: Int -> ReadS UpdateSlackChannelConfiguration
Prelude.Read, Int -> UpdateSlackChannelConfiguration -> ShowS
[UpdateSlackChannelConfiguration] -> ShowS
UpdateSlackChannelConfiguration -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UpdateSlackChannelConfiguration] -> ShowS
$cshowList :: [UpdateSlackChannelConfiguration] -> ShowS
show :: UpdateSlackChannelConfiguration -> String
$cshow :: UpdateSlackChannelConfiguration -> String
showsPrec :: Int -> UpdateSlackChannelConfiguration -> ShowS
$cshowsPrec :: Int -> UpdateSlackChannelConfiguration -> ShowS
Prelude.Show, forall x.
Rep UpdateSlackChannelConfiguration x
-> UpdateSlackChannelConfiguration
forall x.
UpdateSlackChannelConfiguration
-> Rep UpdateSlackChannelConfiguration x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep UpdateSlackChannelConfiguration x
-> UpdateSlackChannelConfiguration
$cfrom :: forall x.
UpdateSlackChannelConfiguration
-> Rep UpdateSlackChannelConfiguration x
Prelude.Generic)

-- |
-- Create a value of 'UpdateSlackChannelConfiguration' 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', 'updateSlackChannelConfiguration_channelName' - The Slack channel name that you want to update.
--
-- 'channelRoleArn', 'updateSlackChannelConfiguration_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/.
--
-- 'notifyOnAddCorrespondenceToCase', 'updateSlackChannelConfiguration_notifyOnAddCorrespondenceToCase' - Whether you want to get notified when a support case has a new
-- correspondence.
--
-- 'notifyOnCaseSeverity', 'updateSlackChannelConfiguration_notifyOnCaseSeverity' - The case severity for a support case that you want to receive
-- notifications.
--
-- If you specify @high@ or @all@, at least one of the following parameters
-- must be @true@:
--
-- -   @notifyOnAddCorrespondenceToCase@
--
-- -   @notifyOnCreateOrReopenCase@
--
-- -   @notifyOnResolveCase@
--
-- If you specify @none@, any of the following parameters that you specify
-- in your request must be @false@:
--
-- -   @notifyOnAddCorrespondenceToCase@
--
-- -   @notifyOnCreateOrReopenCase@
--
-- -   @notifyOnResolveCase@
--
-- If you don\'t specify these parameters in your request, the Amazon Web
-- Services Support App uses the current values by default.
--
-- 'notifyOnCreateOrReopenCase', 'updateSlackChannelConfiguration_notifyOnCreateOrReopenCase' - Whether you want to get notified when a support case is created or
-- reopened.
--
-- 'notifyOnResolveCase', 'updateSlackChannelConfiguration_notifyOnResolveCase' - Whether you want to get notified when a support case is resolved.
--
-- 'channelId', 'updateSlackChannelConfiguration_channelId' - The channel ID in Slack. This ID identifies a channel within a Slack
-- workspace.
--
-- 'teamId', 'updateSlackChannelConfiguration_teamId' - The team ID in Slack. This ID uniquely identifies a Slack workspace,
-- such as @T012ABCDEFG@.
newUpdateSlackChannelConfiguration ::
  -- | 'channelId'
  Prelude.Text ->
  -- | 'teamId'
  Prelude.Text ->
  UpdateSlackChannelConfiguration
newUpdateSlackChannelConfiguration :: Text -> Text -> UpdateSlackChannelConfiguration
newUpdateSlackChannelConfiguration
  Text
pChannelId_
  Text
pTeamId_ =
    UpdateSlackChannelConfiguration'
      { $sel:channelName:UpdateSlackChannelConfiguration' :: Maybe Text
channelName =
          forall a. Maybe a
Prelude.Nothing,
        $sel:channelRoleArn:UpdateSlackChannelConfiguration' :: Maybe Text
channelRoleArn = forall a. Maybe a
Prelude.Nothing,
        $sel:notifyOnAddCorrespondenceToCase:UpdateSlackChannelConfiguration' :: Maybe Bool
notifyOnAddCorrespondenceToCase =
          forall a. Maybe a
Prelude.Nothing,
        $sel:notifyOnCaseSeverity:UpdateSlackChannelConfiguration' :: Maybe NotificationSeverityLevel
notifyOnCaseSeverity = forall a. Maybe a
Prelude.Nothing,
        $sel:notifyOnCreateOrReopenCase:UpdateSlackChannelConfiguration' :: Maybe Bool
notifyOnCreateOrReopenCase =
          forall a. Maybe a
Prelude.Nothing,
        $sel:notifyOnResolveCase:UpdateSlackChannelConfiguration' :: Maybe Bool
notifyOnResolveCase = forall a. Maybe a
Prelude.Nothing,
        $sel:channelId:UpdateSlackChannelConfiguration' :: Text
channelId = Text
pChannelId_,
        $sel:teamId:UpdateSlackChannelConfiguration' :: Text
teamId = Text
pTeamId_
      }

-- | The Slack channel name that you want to update.
updateSlackChannelConfiguration_channelName :: Lens.Lens' UpdateSlackChannelConfiguration (Prelude.Maybe Prelude.Text)
updateSlackChannelConfiguration_channelName :: Lens' UpdateSlackChannelConfiguration (Maybe Text)
updateSlackChannelConfiguration_channelName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateSlackChannelConfiguration' {Maybe Text
channelName :: Maybe Text
$sel:channelName:UpdateSlackChannelConfiguration' :: UpdateSlackChannelConfiguration -> Maybe Text
channelName} -> Maybe Text
channelName) (\s :: UpdateSlackChannelConfiguration
s@UpdateSlackChannelConfiguration' {} Maybe Text
a -> UpdateSlackChannelConfiguration
s {$sel:channelName:UpdateSlackChannelConfiguration' :: Maybe Text
channelName = Maybe Text
a} :: UpdateSlackChannelConfiguration)

-- | 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/.
updateSlackChannelConfiguration_channelRoleArn :: Lens.Lens' UpdateSlackChannelConfiguration (Prelude.Maybe Prelude.Text)
updateSlackChannelConfiguration_channelRoleArn :: Lens' UpdateSlackChannelConfiguration (Maybe Text)
updateSlackChannelConfiguration_channelRoleArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateSlackChannelConfiguration' {Maybe Text
channelRoleArn :: Maybe Text
$sel:channelRoleArn:UpdateSlackChannelConfiguration' :: UpdateSlackChannelConfiguration -> Maybe Text
channelRoleArn} -> Maybe Text
channelRoleArn) (\s :: UpdateSlackChannelConfiguration
s@UpdateSlackChannelConfiguration' {} Maybe Text
a -> UpdateSlackChannelConfiguration
s {$sel:channelRoleArn:UpdateSlackChannelConfiguration' :: Maybe Text
channelRoleArn = Maybe Text
a} :: UpdateSlackChannelConfiguration)

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

-- | The case severity for a support case that you want to receive
-- notifications.
--
-- If you specify @high@ or @all@, at least one of the following parameters
-- must be @true@:
--
-- -   @notifyOnAddCorrespondenceToCase@
--
-- -   @notifyOnCreateOrReopenCase@
--
-- -   @notifyOnResolveCase@
--
-- If you specify @none@, any of the following parameters that you specify
-- in your request must be @false@:
--
-- -   @notifyOnAddCorrespondenceToCase@
--
-- -   @notifyOnCreateOrReopenCase@
--
-- -   @notifyOnResolveCase@
--
-- If you don\'t specify these parameters in your request, the Amazon Web
-- Services Support App uses the current values by default.
updateSlackChannelConfiguration_notifyOnCaseSeverity :: Lens.Lens' UpdateSlackChannelConfiguration (Prelude.Maybe NotificationSeverityLevel)
updateSlackChannelConfiguration_notifyOnCaseSeverity :: Lens'
  UpdateSlackChannelConfiguration (Maybe NotificationSeverityLevel)
updateSlackChannelConfiguration_notifyOnCaseSeverity = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateSlackChannelConfiguration' {Maybe NotificationSeverityLevel
notifyOnCaseSeverity :: Maybe NotificationSeverityLevel
$sel:notifyOnCaseSeverity:UpdateSlackChannelConfiguration' :: UpdateSlackChannelConfiguration -> Maybe NotificationSeverityLevel
notifyOnCaseSeverity} -> Maybe NotificationSeverityLevel
notifyOnCaseSeverity) (\s :: UpdateSlackChannelConfiguration
s@UpdateSlackChannelConfiguration' {} Maybe NotificationSeverityLevel
a -> UpdateSlackChannelConfiguration
s {$sel:notifyOnCaseSeverity:UpdateSlackChannelConfiguration' :: Maybe NotificationSeverityLevel
notifyOnCaseSeverity = Maybe NotificationSeverityLevel
a} :: UpdateSlackChannelConfiguration)

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

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

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

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

instance
  Core.AWSRequest
    UpdateSlackChannelConfiguration
  where
  type
    AWSResponse UpdateSlackChannelConfiguration =
      UpdateSlackChannelConfigurationResponse
  request :: (Service -> Service)
-> UpdateSlackChannelConfiguration
-> Request UpdateSlackChannelConfiguration
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 UpdateSlackChannelConfiguration
-> ClientResponse ClientBody
-> m (Either
        Error
        (ClientResponse (AWSResponse UpdateSlackChannelConfiguration)))
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 ->
          Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Bool
-> Maybe NotificationSeverityLevel
-> Maybe Bool
-> Maybe Bool
-> Maybe Text
-> Int
-> UpdateSlackChannelConfigurationResponse
UpdateSlackChannelConfigurationResponse'
            forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"channelId")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"channelName")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"channelRoleArn")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"notifyOnAddCorrespondenceToCase")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"notifyOnCaseSeverity")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"notifyOnCreateOrReopenCase")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"notifyOnResolveCase")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"teamId")
            forall (f :: * -> *) a b. Applicative f => 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
    UpdateSlackChannelConfiguration
  where
  hashWithSalt :: Int -> UpdateSlackChannelConfiguration -> Int
hashWithSalt
    Int
_salt
    UpdateSlackChannelConfiguration' {Maybe Bool
Maybe Text
Maybe NotificationSeverityLevel
Text
teamId :: Text
channelId :: Text
notifyOnResolveCase :: Maybe Bool
notifyOnCreateOrReopenCase :: Maybe Bool
notifyOnCaseSeverity :: Maybe NotificationSeverityLevel
notifyOnAddCorrespondenceToCase :: Maybe Bool
channelRoleArn :: Maybe Text
channelName :: Maybe Text
$sel:teamId:UpdateSlackChannelConfiguration' :: UpdateSlackChannelConfiguration -> Text
$sel:channelId:UpdateSlackChannelConfiguration' :: UpdateSlackChannelConfiguration -> Text
$sel:notifyOnResolveCase:UpdateSlackChannelConfiguration' :: UpdateSlackChannelConfiguration -> Maybe Bool
$sel:notifyOnCreateOrReopenCase:UpdateSlackChannelConfiguration' :: UpdateSlackChannelConfiguration -> Maybe Bool
$sel:notifyOnCaseSeverity:UpdateSlackChannelConfiguration' :: UpdateSlackChannelConfiguration -> Maybe NotificationSeverityLevel
$sel:notifyOnAddCorrespondenceToCase:UpdateSlackChannelConfiguration' :: UpdateSlackChannelConfiguration -> Maybe Bool
$sel:channelRoleArn:UpdateSlackChannelConfiguration' :: UpdateSlackChannelConfiguration -> Maybe Text
$sel:channelName:UpdateSlackChannelConfiguration' :: UpdateSlackChannelConfiguration -> 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 Text
channelRoleArn
        forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Bool
notifyOnAddCorrespondenceToCase
        forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe NotificationSeverityLevel
notifyOnCaseSeverity
        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
teamId

instance
  Prelude.NFData
    UpdateSlackChannelConfiguration
  where
  rnf :: UpdateSlackChannelConfiguration -> ()
rnf UpdateSlackChannelConfiguration' {Maybe Bool
Maybe Text
Maybe NotificationSeverityLevel
Text
teamId :: Text
channelId :: Text
notifyOnResolveCase :: Maybe Bool
notifyOnCreateOrReopenCase :: Maybe Bool
notifyOnCaseSeverity :: Maybe NotificationSeverityLevel
notifyOnAddCorrespondenceToCase :: Maybe Bool
channelRoleArn :: Maybe Text
channelName :: Maybe Text
$sel:teamId:UpdateSlackChannelConfiguration' :: UpdateSlackChannelConfiguration -> Text
$sel:channelId:UpdateSlackChannelConfiguration' :: UpdateSlackChannelConfiguration -> Text
$sel:notifyOnResolveCase:UpdateSlackChannelConfiguration' :: UpdateSlackChannelConfiguration -> Maybe Bool
$sel:notifyOnCreateOrReopenCase:UpdateSlackChannelConfiguration' :: UpdateSlackChannelConfiguration -> Maybe Bool
$sel:notifyOnCaseSeverity:UpdateSlackChannelConfiguration' :: UpdateSlackChannelConfiguration -> Maybe NotificationSeverityLevel
$sel:notifyOnAddCorrespondenceToCase:UpdateSlackChannelConfiguration' :: UpdateSlackChannelConfiguration -> Maybe Bool
$sel:channelRoleArn:UpdateSlackChannelConfiguration' :: UpdateSlackChannelConfiguration -> Maybe Text
$sel:channelName:UpdateSlackChannelConfiguration' :: UpdateSlackChannelConfiguration -> 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 Text
channelRoleArn
      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 NotificationSeverityLevel
notifyOnCaseSeverity
      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
teamId

instance
  Data.ToHeaders
    UpdateSlackChannelConfiguration
  where
  toHeaders :: UpdateSlackChannelConfiguration -> 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 UpdateSlackChannelConfiguration where
  toJSON :: UpdateSlackChannelConfiguration -> Value
toJSON UpdateSlackChannelConfiguration' {Maybe Bool
Maybe Text
Maybe NotificationSeverityLevel
Text
teamId :: Text
channelId :: Text
notifyOnResolveCase :: Maybe Bool
notifyOnCreateOrReopenCase :: Maybe Bool
notifyOnCaseSeverity :: Maybe NotificationSeverityLevel
notifyOnAddCorrespondenceToCase :: Maybe Bool
channelRoleArn :: Maybe Text
channelName :: Maybe Text
$sel:teamId:UpdateSlackChannelConfiguration' :: UpdateSlackChannelConfiguration -> Text
$sel:channelId:UpdateSlackChannelConfiguration' :: UpdateSlackChannelConfiguration -> Text
$sel:notifyOnResolveCase:UpdateSlackChannelConfiguration' :: UpdateSlackChannelConfiguration -> Maybe Bool
$sel:notifyOnCreateOrReopenCase:UpdateSlackChannelConfiguration' :: UpdateSlackChannelConfiguration -> Maybe Bool
$sel:notifyOnCaseSeverity:UpdateSlackChannelConfiguration' :: UpdateSlackChannelConfiguration -> Maybe NotificationSeverityLevel
$sel:notifyOnAddCorrespondenceToCase:UpdateSlackChannelConfiguration' :: UpdateSlackChannelConfiguration -> Maybe Bool
$sel:channelRoleArn:UpdateSlackChannelConfiguration' :: UpdateSlackChannelConfiguration -> Maybe Text
$sel:channelName:UpdateSlackChannelConfiguration' :: UpdateSlackChannelConfiguration -> 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
"channelRoleArn" 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
channelRoleArn,
            (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
"notifyOnCaseSeverity" 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 NotificationSeverityLevel
notifyOnCaseSeverity,
            (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
"teamId" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
teamId)
          ]
      )

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

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

-- | /See:/ 'newUpdateSlackChannelConfigurationResponse' smart constructor.
data UpdateSlackChannelConfigurationResponse = UpdateSlackChannelConfigurationResponse'
  { -- | The channel ID in Slack. This ID identifies a channel within a Slack
    -- workspace.
    UpdateSlackChannelConfigurationResponse -> Maybe Text
channelId :: Prelude.Maybe Prelude.Text,
    -- | The name of the Slack channel that you configure for the Amazon Web
    -- Services Support App.
    UpdateSlackChannelConfigurationResponse -> Maybe Text
channelName :: Prelude.Maybe 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/.
    UpdateSlackChannelConfigurationResponse -> Maybe Text
channelRoleArn :: Prelude.Maybe Prelude.Text,
    -- | Whether you want to get notified when a support case has a new
    -- correspondence.
    UpdateSlackChannelConfigurationResponse -> Maybe Bool
notifyOnAddCorrespondenceToCase :: Prelude.Maybe Prelude.Bool,
    -- | The case severity for a support case that you want to receive
    -- notifications.
    UpdateSlackChannelConfigurationResponse
-> Maybe NotificationSeverityLevel
notifyOnCaseSeverity :: Prelude.Maybe NotificationSeverityLevel,
    -- | Whether you want to get notified when a support case is created or
    -- reopened.
    UpdateSlackChannelConfigurationResponse -> Maybe Bool
notifyOnCreateOrReopenCase :: Prelude.Maybe Prelude.Bool,
    -- | Whether you want to get notified when a support case is resolved.
    UpdateSlackChannelConfigurationResponse -> Maybe Bool
notifyOnResolveCase :: Prelude.Maybe Prelude.Bool,
    -- | The team ID in Slack. This ID uniquely identifies a Slack workspace,
    -- such as @T012ABCDEFG@.
    UpdateSlackChannelConfigurationResponse -> Maybe Text
teamId :: Prelude.Maybe Prelude.Text,
    -- | The response's http status code.
    UpdateSlackChannelConfigurationResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (UpdateSlackChannelConfigurationResponse
-> UpdateSlackChannelConfigurationResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UpdateSlackChannelConfigurationResponse
-> UpdateSlackChannelConfigurationResponse -> Bool
$c/= :: UpdateSlackChannelConfigurationResponse
-> UpdateSlackChannelConfigurationResponse -> Bool
== :: UpdateSlackChannelConfigurationResponse
-> UpdateSlackChannelConfigurationResponse -> Bool
$c== :: UpdateSlackChannelConfigurationResponse
-> UpdateSlackChannelConfigurationResponse -> Bool
Prelude.Eq, ReadPrec [UpdateSlackChannelConfigurationResponse]
ReadPrec UpdateSlackChannelConfigurationResponse
Int -> ReadS UpdateSlackChannelConfigurationResponse
ReadS [UpdateSlackChannelConfigurationResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [UpdateSlackChannelConfigurationResponse]
$creadListPrec :: ReadPrec [UpdateSlackChannelConfigurationResponse]
readPrec :: ReadPrec UpdateSlackChannelConfigurationResponse
$creadPrec :: ReadPrec UpdateSlackChannelConfigurationResponse
readList :: ReadS [UpdateSlackChannelConfigurationResponse]
$creadList :: ReadS [UpdateSlackChannelConfigurationResponse]
readsPrec :: Int -> ReadS UpdateSlackChannelConfigurationResponse
$creadsPrec :: Int -> ReadS UpdateSlackChannelConfigurationResponse
Prelude.Read, Int -> UpdateSlackChannelConfigurationResponse -> ShowS
[UpdateSlackChannelConfigurationResponse] -> ShowS
UpdateSlackChannelConfigurationResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UpdateSlackChannelConfigurationResponse] -> ShowS
$cshowList :: [UpdateSlackChannelConfigurationResponse] -> ShowS
show :: UpdateSlackChannelConfigurationResponse -> String
$cshow :: UpdateSlackChannelConfigurationResponse -> String
showsPrec :: Int -> UpdateSlackChannelConfigurationResponse -> ShowS
$cshowsPrec :: Int -> UpdateSlackChannelConfigurationResponse -> ShowS
Prelude.Show, forall x.
Rep UpdateSlackChannelConfigurationResponse x
-> UpdateSlackChannelConfigurationResponse
forall x.
UpdateSlackChannelConfigurationResponse
-> Rep UpdateSlackChannelConfigurationResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep UpdateSlackChannelConfigurationResponse x
-> UpdateSlackChannelConfigurationResponse
$cfrom :: forall x.
UpdateSlackChannelConfigurationResponse
-> Rep UpdateSlackChannelConfigurationResponse x
Prelude.Generic)

-- |
-- Create a value of 'UpdateSlackChannelConfigurationResponse' 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', 'updateSlackChannelConfigurationResponse_channelId' - The channel ID in Slack. This ID identifies a channel within a Slack
-- workspace.
--
-- 'channelName', 'updateSlackChannelConfigurationResponse_channelName' - The name of the Slack channel that you configure for the Amazon Web
-- Services Support App.
--
-- 'channelRoleArn', 'updateSlackChannelConfigurationResponse_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/.
--
-- 'notifyOnAddCorrespondenceToCase', 'updateSlackChannelConfigurationResponse_notifyOnAddCorrespondenceToCase' - Whether you want to get notified when a support case has a new
-- correspondence.
--
-- 'notifyOnCaseSeverity', 'updateSlackChannelConfigurationResponse_notifyOnCaseSeverity' - The case severity for a support case that you want to receive
-- notifications.
--
-- 'notifyOnCreateOrReopenCase', 'updateSlackChannelConfigurationResponse_notifyOnCreateOrReopenCase' - Whether you want to get notified when a support case is created or
-- reopened.
--
-- 'notifyOnResolveCase', 'updateSlackChannelConfigurationResponse_notifyOnResolveCase' - Whether you want to get notified when a support case is resolved.
--
-- 'teamId', 'updateSlackChannelConfigurationResponse_teamId' - The team ID in Slack. This ID uniquely identifies a Slack workspace,
-- such as @T012ABCDEFG@.
--
-- 'httpStatus', 'updateSlackChannelConfigurationResponse_httpStatus' - The response's http status code.
newUpdateSlackChannelConfigurationResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  UpdateSlackChannelConfigurationResponse
newUpdateSlackChannelConfigurationResponse :: Int -> UpdateSlackChannelConfigurationResponse
newUpdateSlackChannelConfigurationResponse
  Int
pHttpStatus_ =
    UpdateSlackChannelConfigurationResponse'
      { $sel:channelId:UpdateSlackChannelConfigurationResponse' :: Maybe Text
channelId =
          forall a. Maybe a
Prelude.Nothing,
        $sel:channelName:UpdateSlackChannelConfigurationResponse' :: Maybe Text
channelName = forall a. Maybe a
Prelude.Nothing,
        $sel:channelRoleArn:UpdateSlackChannelConfigurationResponse' :: Maybe Text
channelRoleArn = forall a. Maybe a
Prelude.Nothing,
        $sel:notifyOnAddCorrespondenceToCase:UpdateSlackChannelConfigurationResponse' :: Maybe Bool
notifyOnAddCorrespondenceToCase =
          forall a. Maybe a
Prelude.Nothing,
        $sel:notifyOnCaseSeverity:UpdateSlackChannelConfigurationResponse' :: Maybe NotificationSeverityLevel
notifyOnCaseSeverity =
          forall a. Maybe a
Prelude.Nothing,
        $sel:notifyOnCreateOrReopenCase:UpdateSlackChannelConfigurationResponse' :: Maybe Bool
notifyOnCreateOrReopenCase =
          forall a. Maybe a
Prelude.Nothing,
        $sel:notifyOnResolveCase:UpdateSlackChannelConfigurationResponse' :: Maybe Bool
notifyOnResolveCase =
          forall a. Maybe a
Prelude.Nothing,
        $sel:teamId:UpdateSlackChannelConfigurationResponse' :: Maybe Text
teamId = forall a. Maybe a
Prelude.Nothing,
        $sel:httpStatus:UpdateSlackChannelConfigurationResponse' :: Int
httpStatus = Int
pHttpStatus_
      }

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

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

-- | 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/.
updateSlackChannelConfigurationResponse_channelRoleArn :: Lens.Lens' UpdateSlackChannelConfigurationResponse (Prelude.Maybe Prelude.Text)
updateSlackChannelConfigurationResponse_channelRoleArn :: Lens' UpdateSlackChannelConfigurationResponse (Maybe Text)
updateSlackChannelConfigurationResponse_channelRoleArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateSlackChannelConfigurationResponse' {Maybe Text
channelRoleArn :: Maybe Text
$sel:channelRoleArn:UpdateSlackChannelConfigurationResponse' :: UpdateSlackChannelConfigurationResponse -> Maybe Text
channelRoleArn} -> Maybe Text
channelRoleArn) (\s :: UpdateSlackChannelConfigurationResponse
s@UpdateSlackChannelConfigurationResponse' {} Maybe Text
a -> UpdateSlackChannelConfigurationResponse
s {$sel:channelRoleArn:UpdateSlackChannelConfigurationResponse' :: Maybe Text
channelRoleArn = Maybe Text
a} :: UpdateSlackChannelConfigurationResponse)

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

-- | The case severity for a support case that you want to receive
-- notifications.
updateSlackChannelConfigurationResponse_notifyOnCaseSeverity :: Lens.Lens' UpdateSlackChannelConfigurationResponse (Prelude.Maybe NotificationSeverityLevel)
updateSlackChannelConfigurationResponse_notifyOnCaseSeverity :: Lens'
  UpdateSlackChannelConfigurationResponse
  (Maybe NotificationSeverityLevel)
updateSlackChannelConfigurationResponse_notifyOnCaseSeverity = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateSlackChannelConfigurationResponse' {Maybe NotificationSeverityLevel
notifyOnCaseSeverity :: Maybe NotificationSeverityLevel
$sel:notifyOnCaseSeverity:UpdateSlackChannelConfigurationResponse' :: UpdateSlackChannelConfigurationResponse
-> Maybe NotificationSeverityLevel
notifyOnCaseSeverity} -> Maybe NotificationSeverityLevel
notifyOnCaseSeverity) (\s :: UpdateSlackChannelConfigurationResponse
s@UpdateSlackChannelConfigurationResponse' {} Maybe NotificationSeverityLevel
a -> UpdateSlackChannelConfigurationResponse
s {$sel:notifyOnCaseSeverity:UpdateSlackChannelConfigurationResponse' :: Maybe NotificationSeverityLevel
notifyOnCaseSeverity = Maybe NotificationSeverityLevel
a} :: UpdateSlackChannelConfigurationResponse)

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

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

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

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

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