{-# 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.RegisterSlackWorkspaceForOrganization
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Registers a Slack workspace for your Amazon Web Services account. To
-- call this API, your account must be part of an organization in
-- Organizations.
--
-- If you\'re the /management account/ and you want to register Slack
-- workspaces for your organization, you must complete the following tasks:
--
-- 1.  Sign in to the
--     <https://console.aws.amazon.com/support/app Amazon Web Services Support Center>
--     and authorize the Slack workspaces where you want your organization
--     to have access to. See
--     <https://docs.aws.amazon.com/awssupport/latest/user/authorize-slack-workspace.html Authorize a Slack workspace>
--     in the /Amazon Web Services Support User Guide/.
--
-- 2.  Call the @RegisterSlackWorkspaceForOrganization@ API to authorize
--     each Slack workspace for the organization.
--
-- After the management account authorizes the Slack workspace, member
-- accounts can call this API to authorize the same Slack workspace for
-- their individual accounts. Member accounts don\'t need to authorize the
-- Slack workspace manually through the
-- <https://console.aws.amazon.com/support/app Amazon Web Services Support Center>.
--
-- To use the Amazon Web Services Support App, each account must then
-- complete the following tasks:
--
-- -   Create an Identity and Access Management (IAM) role with the
--     required permission. 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>.
--
-- -   Configure a Slack channel to use the Amazon Web Services Support App
--     for support cases for that account. For more information, see
--     <https://docs.aws.amazon.com/awssupport/latest/user/add-your-slack-channel.html Configuring a Slack channel>.
module Amazonka.SupportApp.RegisterSlackWorkspaceForOrganization
  ( -- * Creating a Request
    RegisterSlackWorkspaceForOrganization (..),
    newRegisterSlackWorkspaceForOrganization,

    -- * Request Lenses
    registerSlackWorkspaceForOrganization_teamId,

    -- * Destructuring the Response
    RegisterSlackWorkspaceForOrganizationResponse (..),
    newRegisterSlackWorkspaceForOrganizationResponse,

    -- * Response Lenses
    registerSlackWorkspaceForOrganizationResponse_accountType,
    registerSlackWorkspaceForOrganizationResponse_teamId,
    registerSlackWorkspaceForOrganizationResponse_teamName,
    registerSlackWorkspaceForOrganizationResponse_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:/ 'newRegisterSlackWorkspaceForOrganization' smart constructor.
data RegisterSlackWorkspaceForOrganization = RegisterSlackWorkspaceForOrganization'
  { -- | The team ID in Slack. This ID uniquely identifies a Slack workspace,
    -- such as @T012ABCDEFG@. Specify the Slack workspace that you want to use
    -- for your organization.
    RegisterSlackWorkspaceForOrganization -> Text
teamId :: Prelude.Text
  }
  deriving (RegisterSlackWorkspaceForOrganization
-> RegisterSlackWorkspaceForOrganization -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RegisterSlackWorkspaceForOrganization
-> RegisterSlackWorkspaceForOrganization -> Bool
$c/= :: RegisterSlackWorkspaceForOrganization
-> RegisterSlackWorkspaceForOrganization -> Bool
== :: RegisterSlackWorkspaceForOrganization
-> RegisterSlackWorkspaceForOrganization -> Bool
$c== :: RegisterSlackWorkspaceForOrganization
-> RegisterSlackWorkspaceForOrganization -> Bool
Prelude.Eq, ReadPrec [RegisterSlackWorkspaceForOrganization]
ReadPrec RegisterSlackWorkspaceForOrganization
Int -> ReadS RegisterSlackWorkspaceForOrganization
ReadS [RegisterSlackWorkspaceForOrganization]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [RegisterSlackWorkspaceForOrganization]
$creadListPrec :: ReadPrec [RegisterSlackWorkspaceForOrganization]
readPrec :: ReadPrec RegisterSlackWorkspaceForOrganization
$creadPrec :: ReadPrec RegisterSlackWorkspaceForOrganization
readList :: ReadS [RegisterSlackWorkspaceForOrganization]
$creadList :: ReadS [RegisterSlackWorkspaceForOrganization]
readsPrec :: Int -> ReadS RegisterSlackWorkspaceForOrganization
$creadsPrec :: Int -> ReadS RegisterSlackWorkspaceForOrganization
Prelude.Read, Int -> RegisterSlackWorkspaceForOrganization -> ShowS
[RegisterSlackWorkspaceForOrganization] -> ShowS
RegisterSlackWorkspaceForOrganization -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RegisterSlackWorkspaceForOrganization] -> ShowS
$cshowList :: [RegisterSlackWorkspaceForOrganization] -> ShowS
show :: RegisterSlackWorkspaceForOrganization -> String
$cshow :: RegisterSlackWorkspaceForOrganization -> String
showsPrec :: Int -> RegisterSlackWorkspaceForOrganization -> ShowS
$cshowsPrec :: Int -> RegisterSlackWorkspaceForOrganization -> ShowS
Prelude.Show, forall x.
Rep RegisterSlackWorkspaceForOrganization x
-> RegisterSlackWorkspaceForOrganization
forall x.
RegisterSlackWorkspaceForOrganization
-> Rep RegisterSlackWorkspaceForOrganization x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep RegisterSlackWorkspaceForOrganization x
-> RegisterSlackWorkspaceForOrganization
$cfrom :: forall x.
RegisterSlackWorkspaceForOrganization
-> Rep RegisterSlackWorkspaceForOrganization x
Prelude.Generic)

-- |
-- Create a value of 'RegisterSlackWorkspaceForOrganization' 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:
--
-- 'teamId', 'registerSlackWorkspaceForOrganization_teamId' - The team ID in Slack. This ID uniquely identifies a Slack workspace,
-- such as @T012ABCDEFG@. Specify the Slack workspace that you want to use
-- for your organization.
newRegisterSlackWorkspaceForOrganization ::
  -- | 'teamId'
  Prelude.Text ->
  RegisterSlackWorkspaceForOrganization
newRegisterSlackWorkspaceForOrganization :: Text -> RegisterSlackWorkspaceForOrganization
newRegisterSlackWorkspaceForOrganization Text
pTeamId_ =
  RegisterSlackWorkspaceForOrganization'
    { $sel:teamId:RegisterSlackWorkspaceForOrganization' :: Text
teamId =
        Text
pTeamId_
    }

-- | The team ID in Slack. This ID uniquely identifies a Slack workspace,
-- such as @T012ABCDEFG@. Specify the Slack workspace that you want to use
-- for your organization.
registerSlackWorkspaceForOrganization_teamId :: Lens.Lens' RegisterSlackWorkspaceForOrganization Prelude.Text
registerSlackWorkspaceForOrganization_teamId :: Lens' RegisterSlackWorkspaceForOrganization Text
registerSlackWorkspaceForOrganization_teamId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\RegisterSlackWorkspaceForOrganization' {Text
teamId :: Text
$sel:teamId:RegisterSlackWorkspaceForOrganization' :: RegisterSlackWorkspaceForOrganization -> Text
teamId} -> Text
teamId) (\s :: RegisterSlackWorkspaceForOrganization
s@RegisterSlackWorkspaceForOrganization' {} Text
a -> RegisterSlackWorkspaceForOrganization
s {$sel:teamId:RegisterSlackWorkspaceForOrganization' :: Text
teamId = Text
a} :: RegisterSlackWorkspaceForOrganization)

instance
  Core.AWSRequest
    RegisterSlackWorkspaceForOrganization
  where
  type
    AWSResponse
      RegisterSlackWorkspaceForOrganization =
      RegisterSlackWorkspaceForOrganizationResponse
  request :: (Service -> Service)
-> RegisterSlackWorkspaceForOrganization
-> Request RegisterSlackWorkspaceForOrganization
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 RegisterSlackWorkspaceForOrganization
-> ClientResponse ClientBody
-> m (Either
        Error
        (ClientResponse
           (AWSResponse RegisterSlackWorkspaceForOrganization)))
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 AccountType
-> Maybe Text
-> Maybe Text
-> Int
-> RegisterSlackWorkspaceForOrganizationResponse
RegisterSlackWorkspaceForOrganizationResponse'
            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
"accountType")
            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.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"teamName")
            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
    RegisterSlackWorkspaceForOrganization
  where
  hashWithSalt :: Int -> RegisterSlackWorkspaceForOrganization -> Int
hashWithSalt
    Int
_salt
    RegisterSlackWorkspaceForOrganization' {Text
teamId :: Text
$sel:teamId:RegisterSlackWorkspaceForOrganization' :: RegisterSlackWorkspaceForOrganization -> Text
..} =
      Int
_salt forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
teamId

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

instance
  Data.ToHeaders
    RegisterSlackWorkspaceForOrganization
  where
  toHeaders :: RegisterSlackWorkspaceForOrganization -> 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
    RegisterSlackWorkspaceForOrganization
  where
  toJSON :: RegisterSlackWorkspaceForOrganization -> Value
toJSON RegisterSlackWorkspaceForOrganization' {Text
teamId :: Text
$sel:teamId:RegisterSlackWorkspaceForOrganization' :: RegisterSlackWorkspaceForOrganization -> Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [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
    RegisterSlackWorkspaceForOrganization
  where
  toPath :: RegisterSlackWorkspaceForOrganization -> ByteString
toPath =
    forall a b. a -> b -> a
Prelude.const
      ByteString
"/control/register-slack-workspace-for-organization"

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

-- | /See:/ 'newRegisterSlackWorkspaceForOrganizationResponse' smart constructor.
data RegisterSlackWorkspaceForOrganizationResponse = RegisterSlackWorkspaceForOrganizationResponse'
  { -- | Whether the Amazon Web Services account is a management or member
    -- account that\'s part of an organization in Organizations.
    RegisterSlackWorkspaceForOrganizationResponse -> Maybe AccountType
accountType :: Prelude.Maybe AccountType,
    -- | The team ID in Slack. This ID uniquely identifies a Slack workspace,
    -- such as @T012ABCDEFG@.
    RegisterSlackWorkspaceForOrganizationResponse -> Maybe Text
teamId :: Prelude.Maybe Prelude.Text,
    -- | The name of the Slack workspace.
    RegisterSlackWorkspaceForOrganizationResponse -> Maybe Text
teamName :: Prelude.Maybe Prelude.Text,
    -- | The response's http status code.
    RegisterSlackWorkspaceForOrganizationResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (RegisterSlackWorkspaceForOrganizationResponse
-> RegisterSlackWorkspaceForOrganizationResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RegisterSlackWorkspaceForOrganizationResponse
-> RegisterSlackWorkspaceForOrganizationResponse -> Bool
$c/= :: RegisterSlackWorkspaceForOrganizationResponse
-> RegisterSlackWorkspaceForOrganizationResponse -> Bool
== :: RegisterSlackWorkspaceForOrganizationResponse
-> RegisterSlackWorkspaceForOrganizationResponse -> Bool
$c== :: RegisterSlackWorkspaceForOrganizationResponse
-> RegisterSlackWorkspaceForOrganizationResponse -> Bool
Prelude.Eq, ReadPrec [RegisterSlackWorkspaceForOrganizationResponse]
ReadPrec RegisterSlackWorkspaceForOrganizationResponse
Int -> ReadS RegisterSlackWorkspaceForOrganizationResponse
ReadS [RegisterSlackWorkspaceForOrganizationResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [RegisterSlackWorkspaceForOrganizationResponse]
$creadListPrec :: ReadPrec [RegisterSlackWorkspaceForOrganizationResponse]
readPrec :: ReadPrec RegisterSlackWorkspaceForOrganizationResponse
$creadPrec :: ReadPrec RegisterSlackWorkspaceForOrganizationResponse
readList :: ReadS [RegisterSlackWorkspaceForOrganizationResponse]
$creadList :: ReadS [RegisterSlackWorkspaceForOrganizationResponse]
readsPrec :: Int -> ReadS RegisterSlackWorkspaceForOrganizationResponse
$creadsPrec :: Int -> ReadS RegisterSlackWorkspaceForOrganizationResponse
Prelude.Read, Int -> RegisterSlackWorkspaceForOrganizationResponse -> ShowS
[RegisterSlackWorkspaceForOrganizationResponse] -> ShowS
RegisterSlackWorkspaceForOrganizationResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RegisterSlackWorkspaceForOrganizationResponse] -> ShowS
$cshowList :: [RegisterSlackWorkspaceForOrganizationResponse] -> ShowS
show :: RegisterSlackWorkspaceForOrganizationResponse -> String
$cshow :: RegisterSlackWorkspaceForOrganizationResponse -> String
showsPrec :: Int -> RegisterSlackWorkspaceForOrganizationResponse -> ShowS
$cshowsPrec :: Int -> RegisterSlackWorkspaceForOrganizationResponse -> ShowS
Prelude.Show, forall x.
Rep RegisterSlackWorkspaceForOrganizationResponse x
-> RegisterSlackWorkspaceForOrganizationResponse
forall x.
RegisterSlackWorkspaceForOrganizationResponse
-> Rep RegisterSlackWorkspaceForOrganizationResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep RegisterSlackWorkspaceForOrganizationResponse x
-> RegisterSlackWorkspaceForOrganizationResponse
$cfrom :: forall x.
RegisterSlackWorkspaceForOrganizationResponse
-> Rep RegisterSlackWorkspaceForOrganizationResponse x
Prelude.Generic)

-- |
-- Create a value of 'RegisterSlackWorkspaceForOrganizationResponse' 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:
--
-- 'accountType', 'registerSlackWorkspaceForOrganizationResponse_accountType' - Whether the Amazon Web Services account is a management or member
-- account that\'s part of an organization in Organizations.
--
-- 'teamId', 'registerSlackWorkspaceForOrganizationResponse_teamId' - The team ID in Slack. This ID uniquely identifies a Slack workspace,
-- such as @T012ABCDEFG@.
--
-- 'teamName', 'registerSlackWorkspaceForOrganizationResponse_teamName' - The name of the Slack workspace.
--
-- 'httpStatus', 'registerSlackWorkspaceForOrganizationResponse_httpStatus' - The response's http status code.
newRegisterSlackWorkspaceForOrganizationResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  RegisterSlackWorkspaceForOrganizationResponse
newRegisterSlackWorkspaceForOrganizationResponse :: Int -> RegisterSlackWorkspaceForOrganizationResponse
newRegisterSlackWorkspaceForOrganizationResponse
  Int
pHttpStatus_ =
    RegisterSlackWorkspaceForOrganizationResponse'
      { $sel:accountType:RegisterSlackWorkspaceForOrganizationResponse' :: Maybe AccountType
accountType =
          forall a. Maybe a
Prelude.Nothing,
        $sel:teamId:RegisterSlackWorkspaceForOrganizationResponse' :: Maybe Text
teamId = forall a. Maybe a
Prelude.Nothing,
        $sel:teamName:RegisterSlackWorkspaceForOrganizationResponse' :: Maybe Text
teamName = forall a. Maybe a
Prelude.Nothing,
        $sel:httpStatus:RegisterSlackWorkspaceForOrganizationResponse' :: Int
httpStatus = Int
pHttpStatus_
      }

-- | Whether the Amazon Web Services account is a management or member
-- account that\'s part of an organization in Organizations.
registerSlackWorkspaceForOrganizationResponse_accountType :: Lens.Lens' RegisterSlackWorkspaceForOrganizationResponse (Prelude.Maybe AccountType)
registerSlackWorkspaceForOrganizationResponse_accountType :: Lens'
  RegisterSlackWorkspaceForOrganizationResponse (Maybe AccountType)
registerSlackWorkspaceForOrganizationResponse_accountType = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\RegisterSlackWorkspaceForOrganizationResponse' {Maybe AccountType
accountType :: Maybe AccountType
$sel:accountType:RegisterSlackWorkspaceForOrganizationResponse' :: RegisterSlackWorkspaceForOrganizationResponse -> Maybe AccountType
accountType} -> Maybe AccountType
accountType) (\s :: RegisterSlackWorkspaceForOrganizationResponse
s@RegisterSlackWorkspaceForOrganizationResponse' {} Maybe AccountType
a -> RegisterSlackWorkspaceForOrganizationResponse
s {$sel:accountType:RegisterSlackWorkspaceForOrganizationResponse' :: Maybe AccountType
accountType = Maybe AccountType
a} :: RegisterSlackWorkspaceForOrganizationResponse)

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

-- | The name of the Slack workspace.
registerSlackWorkspaceForOrganizationResponse_teamName :: Lens.Lens' RegisterSlackWorkspaceForOrganizationResponse (Prelude.Maybe Prelude.Text)
registerSlackWorkspaceForOrganizationResponse_teamName :: Lens' RegisterSlackWorkspaceForOrganizationResponse (Maybe Text)
registerSlackWorkspaceForOrganizationResponse_teamName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\RegisterSlackWorkspaceForOrganizationResponse' {Maybe Text
teamName :: Maybe Text
$sel:teamName:RegisterSlackWorkspaceForOrganizationResponse' :: RegisterSlackWorkspaceForOrganizationResponse -> Maybe Text
teamName} -> Maybe Text
teamName) (\s :: RegisterSlackWorkspaceForOrganizationResponse
s@RegisterSlackWorkspaceForOrganizationResponse' {} Maybe Text
a -> RegisterSlackWorkspaceForOrganizationResponse
s {$sel:teamName:RegisterSlackWorkspaceForOrganizationResponse' :: Maybe Text
teamName = Maybe Text
a} :: RegisterSlackWorkspaceForOrganizationResponse)

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

instance
  Prelude.NFData
    RegisterSlackWorkspaceForOrganizationResponse
  where
  rnf :: RegisterSlackWorkspaceForOrganizationResponse -> ()
rnf
    RegisterSlackWorkspaceForOrganizationResponse' {Int
Maybe Text
Maybe AccountType
httpStatus :: Int
teamName :: Maybe Text
teamId :: Maybe Text
accountType :: Maybe AccountType
$sel:httpStatus:RegisterSlackWorkspaceForOrganizationResponse' :: RegisterSlackWorkspaceForOrganizationResponse -> Int
$sel:teamName:RegisterSlackWorkspaceForOrganizationResponse' :: RegisterSlackWorkspaceForOrganizationResponse -> Maybe Text
$sel:teamId:RegisterSlackWorkspaceForOrganizationResponse' :: RegisterSlackWorkspaceForOrganizationResponse -> Maybe Text
$sel:accountType:RegisterSlackWorkspaceForOrganizationResponse' :: RegisterSlackWorkspaceForOrganizationResponse -> Maybe AccountType
..} =
      forall a. NFData a => a -> ()
Prelude.rnf Maybe AccountType
accountType
        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 Maybe Text
teamName
        seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus