{-# 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.Grafana.CreateWorkspace
-- 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 /workspace/. In a workspace, you can create Grafana dashboards
-- and visualizations to analyze your metrics, logs, and traces. You don\'t
-- have to build, package, or deploy any hardware to run the Grafana
-- server.
--
-- Don\'t use @CreateWorkspace@ to modify an existing workspace. Instead,
-- use
-- <https://docs.aws.amazon.com/grafana/latest/APIReference/API_UpdateWorkspace.html UpdateWorkspace>.
module Amazonka.Grafana.CreateWorkspace
  ( -- * Creating a Request
    CreateWorkspace (..),
    newCreateWorkspace,

    -- * Request Lenses
    createWorkspace_clientToken,
    createWorkspace_configuration,
    createWorkspace_organizationRoleName,
    createWorkspace_stackSetName,
    createWorkspace_tags,
    createWorkspace_vpcConfiguration,
    createWorkspace_workspaceDataSources,
    createWorkspace_workspaceDescription,
    createWorkspace_workspaceName,
    createWorkspace_workspaceNotificationDestinations,
    createWorkspace_workspaceOrganizationalUnits,
    createWorkspace_workspaceRoleArn,
    createWorkspace_accountAccessType,
    createWorkspace_authenticationProviders,
    createWorkspace_permissionType,

    -- * Destructuring the Response
    CreateWorkspaceResponse (..),
    newCreateWorkspaceResponse,

    -- * Response Lenses
    createWorkspaceResponse_httpStatus,
    createWorkspaceResponse_workspace,
  )
where

import qualified Amazonka.Core as Core
import qualified Amazonka.Core.Lens.Internal as Lens
import qualified Amazonka.Data as Data
import Amazonka.Grafana.Types
import qualified Amazonka.Prelude as Prelude
import qualified Amazonka.Request as Request
import qualified Amazonka.Response as Response

-- | /See:/ 'newCreateWorkspace' smart constructor.
data CreateWorkspace = CreateWorkspace'
  { -- | A unique, case-sensitive, user-provided identifier to ensure the
    -- idempotency of the request.
    CreateWorkspace -> Maybe Text
clientToken :: Prelude.Maybe Prelude.Text,
    -- | The configuration string for the workspace that you create. For more
    -- information about the format and configuration options available, see
    -- <https://docs.aws.amazon.com/grafana/latest/userguide/AMG-configure-workspace.html Working in your Grafana workspace>.
    CreateWorkspace -> Maybe Text
configuration :: Prelude.Maybe Prelude.Text,
    -- | The name of an IAM role that already exists to use with Organizations to
    -- access Amazon Web Services data sources and notification channels in
    -- other accounts in an organization.
    CreateWorkspace -> Maybe (Sensitive Text)
organizationRoleName :: Prelude.Maybe (Data.Sensitive Prelude.Text),
    -- | The name of the CloudFormation stack set to use to generate IAM roles to
    -- be used for this workspace.
    CreateWorkspace -> Maybe Text
stackSetName :: Prelude.Maybe Prelude.Text,
    -- | The list of tags associated with the workspace.
    CreateWorkspace -> Maybe (HashMap Text Text)
tags :: Prelude.Maybe (Prelude.HashMap Prelude.Text Prelude.Text),
    -- | The configuration settings for an Amazon VPC that contains data sources
    -- for your Grafana workspace to connect to.
    CreateWorkspace -> Maybe VpcConfiguration
vpcConfiguration :: Prelude.Maybe VpcConfiguration,
    -- | Specify the Amazon Web Services data sources that you want to be queried
    -- in this workspace. Specifying these data sources here enables Amazon
    -- Managed Grafana to create IAM roles and permissions that allow Amazon
    -- Managed Grafana to read data from these sources. You must still add them
    -- as data sources in the Grafana console in the workspace.
    --
    -- If you don\'t specify a data source here, you can still add it as a data
    -- source in the workspace console later. However, you will then have to
    -- manually configure permissions for it.
    CreateWorkspace -> Maybe [DataSourceType]
workspaceDataSources :: Prelude.Maybe [DataSourceType],
    -- | A description for the workspace. This is used only to help you identify
    -- this workspace.
    --
    -- Pattern: @^[\\\\p{L}\\\\p{Z}\\\\p{N}\\\\p{P}]{0,2048}$@
    CreateWorkspace -> Maybe (Sensitive Text)
workspaceDescription :: Prelude.Maybe (Data.Sensitive Prelude.Text),
    -- | The name for the workspace. It does not have to be unique.
    CreateWorkspace -> Maybe (Sensitive Text)
workspaceName :: Prelude.Maybe (Data.Sensitive Prelude.Text),
    -- | Specify the Amazon Web Services notification channels that you plan to
    -- use in this workspace. Specifying these data sources here enables Amazon
    -- Managed Grafana to create IAM roles and permissions that allow Amazon
    -- Managed Grafana to use these channels.
    CreateWorkspace -> Maybe [NotificationDestinationType]
workspaceNotificationDestinations :: Prelude.Maybe [NotificationDestinationType],
    -- | Specifies the organizational units that this workspace is allowed to use
    -- data sources from, if this workspace is in an account that is part of an
    -- organization.
    CreateWorkspace -> Maybe (Sensitive [Text])
workspaceOrganizationalUnits :: Prelude.Maybe (Data.Sensitive [Prelude.Text]),
    -- | The workspace needs an IAM role that grants permissions to the Amazon
    -- Web Services resources that the workspace will view data from. If you
    -- already have a role that you want to use, specify it here. The
    -- permission type should be set to @CUSTOMER_MANAGED@.
    CreateWorkspace -> Maybe (Sensitive Text)
workspaceRoleArn :: Prelude.Maybe (Data.Sensitive Prelude.Text),
    -- | Specifies whether the workspace can access Amazon Web Services resources
    -- in this Amazon Web Services account only, or whether it can also access
    -- Amazon Web Services resources in other accounts in the same
    -- organization. If you specify @ORGANIZATION@, you must specify which
    -- organizational units the workspace can access in the
    -- @workspaceOrganizationalUnits@ parameter.
    CreateWorkspace -> AccountAccessType
accountAccessType :: AccountAccessType,
    -- | Specifies whether this workspace uses SAML 2.0, IAM Identity Center
    -- (successor to Single Sign-On), or both to authenticate users for using
    -- the Grafana console within a workspace. For more information, see
    -- <https://docs.aws.amazon.com/grafana/latest/userguide/authentication-in-AMG.html User authentication in Amazon Managed Grafana>.
    CreateWorkspace -> [AuthenticationProviderTypes]
authenticationProviders :: [AuthenticationProviderTypes],
    -- | If you specify @SERVICE_MANAGED@ on AWS Grafana console, Amazon Managed
    -- Grafana automatically creates the IAM roles and provisions the
    -- permissions that the workspace needs to use Amazon Web Services data
    -- sources and notification channels. In the CLI mode, the permissionType
    -- @SERVICE_MANAGED@ will not create the IAM role for you. The ability for
    -- the Amazon Managed Grafana to create the IAM role on behalf of the user
    -- is supported only in the Amazon Managed Grafana AWS console. Use only
    -- the @CUSTOMER_MANAGED@ permission type when creating a workspace in the
    -- CLI.
    --
    -- If you specify @CUSTOMER_MANAGED@, you will manage those roles and
    -- permissions yourself. If you are creating this workspace in a member
    -- account of an organization that is not a delegated administrator
    -- account, and you want the workspace to access data sources in other
    -- Amazon Web Services accounts in the organization, you must choose
    -- @CUSTOMER_MANAGED@.
    --
    -- For more information, see
    -- <https://docs.aws.amazon.com/grafana/latest/userguide/AMG-manage-permissions.html Amazon Managed Grafana permissions and policies for Amazon Web Services data sources and notification channels>.
    CreateWorkspace -> PermissionType
permissionType :: PermissionType
  }
  deriving (CreateWorkspace -> CreateWorkspace -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateWorkspace -> CreateWorkspace -> Bool
$c/= :: CreateWorkspace -> CreateWorkspace -> Bool
== :: CreateWorkspace -> CreateWorkspace -> Bool
$c== :: CreateWorkspace -> CreateWorkspace -> Bool
Prelude.Eq, Int -> CreateWorkspace -> ShowS
[CreateWorkspace] -> ShowS
CreateWorkspace -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateWorkspace] -> ShowS
$cshowList :: [CreateWorkspace] -> ShowS
show :: CreateWorkspace -> String
$cshow :: CreateWorkspace -> String
showsPrec :: Int -> CreateWorkspace -> ShowS
$cshowsPrec :: Int -> CreateWorkspace -> ShowS
Prelude.Show, forall x. Rep CreateWorkspace x -> CreateWorkspace
forall x. CreateWorkspace -> Rep CreateWorkspace x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CreateWorkspace x -> CreateWorkspace
$cfrom :: forall x. CreateWorkspace -> Rep CreateWorkspace x
Prelude.Generic)

-- |
-- Create a value of 'CreateWorkspace' 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:
--
-- 'clientToken', 'createWorkspace_clientToken' - A unique, case-sensitive, user-provided identifier to ensure the
-- idempotency of the request.
--
-- 'configuration', 'createWorkspace_configuration' - The configuration string for the workspace that you create. For more
-- information about the format and configuration options available, see
-- <https://docs.aws.amazon.com/grafana/latest/userguide/AMG-configure-workspace.html Working in your Grafana workspace>.
--
-- 'organizationRoleName', 'createWorkspace_organizationRoleName' - The name of an IAM role that already exists to use with Organizations to
-- access Amazon Web Services data sources and notification channels in
-- other accounts in an organization.
--
-- 'stackSetName', 'createWorkspace_stackSetName' - The name of the CloudFormation stack set to use to generate IAM roles to
-- be used for this workspace.
--
-- 'tags', 'createWorkspace_tags' - The list of tags associated with the workspace.
--
-- 'vpcConfiguration', 'createWorkspace_vpcConfiguration' - The configuration settings for an Amazon VPC that contains data sources
-- for your Grafana workspace to connect to.
--
-- 'workspaceDataSources', 'createWorkspace_workspaceDataSources' - Specify the Amazon Web Services data sources that you want to be queried
-- in this workspace. Specifying these data sources here enables Amazon
-- Managed Grafana to create IAM roles and permissions that allow Amazon
-- Managed Grafana to read data from these sources. You must still add them
-- as data sources in the Grafana console in the workspace.
--
-- If you don\'t specify a data source here, you can still add it as a data
-- source in the workspace console later. However, you will then have to
-- manually configure permissions for it.
--
-- 'workspaceDescription', 'createWorkspace_workspaceDescription' - A description for the workspace. This is used only to help you identify
-- this workspace.
--
-- Pattern: @^[\\\\p{L}\\\\p{Z}\\\\p{N}\\\\p{P}]{0,2048}$@
--
-- 'workspaceName', 'createWorkspace_workspaceName' - The name for the workspace. It does not have to be unique.
--
-- 'workspaceNotificationDestinations', 'createWorkspace_workspaceNotificationDestinations' - Specify the Amazon Web Services notification channels that you plan to
-- use in this workspace. Specifying these data sources here enables Amazon
-- Managed Grafana to create IAM roles and permissions that allow Amazon
-- Managed Grafana to use these channels.
--
-- 'workspaceOrganizationalUnits', 'createWorkspace_workspaceOrganizationalUnits' - Specifies the organizational units that this workspace is allowed to use
-- data sources from, if this workspace is in an account that is part of an
-- organization.
--
-- 'workspaceRoleArn', 'createWorkspace_workspaceRoleArn' - The workspace needs an IAM role that grants permissions to the Amazon
-- Web Services resources that the workspace will view data from. If you
-- already have a role that you want to use, specify it here. The
-- permission type should be set to @CUSTOMER_MANAGED@.
--
-- 'accountAccessType', 'createWorkspace_accountAccessType' - Specifies whether the workspace can access Amazon Web Services resources
-- in this Amazon Web Services account only, or whether it can also access
-- Amazon Web Services resources in other accounts in the same
-- organization. If you specify @ORGANIZATION@, you must specify which
-- organizational units the workspace can access in the
-- @workspaceOrganizationalUnits@ parameter.
--
-- 'authenticationProviders', 'createWorkspace_authenticationProviders' - Specifies whether this workspace uses SAML 2.0, IAM Identity Center
-- (successor to Single Sign-On), or both to authenticate users for using
-- the Grafana console within a workspace. For more information, see
-- <https://docs.aws.amazon.com/grafana/latest/userguide/authentication-in-AMG.html User authentication in Amazon Managed Grafana>.
--
-- 'permissionType', 'createWorkspace_permissionType' - If you specify @SERVICE_MANAGED@ on AWS Grafana console, Amazon Managed
-- Grafana automatically creates the IAM roles and provisions the
-- permissions that the workspace needs to use Amazon Web Services data
-- sources and notification channels. In the CLI mode, the permissionType
-- @SERVICE_MANAGED@ will not create the IAM role for you. The ability for
-- the Amazon Managed Grafana to create the IAM role on behalf of the user
-- is supported only in the Amazon Managed Grafana AWS console. Use only
-- the @CUSTOMER_MANAGED@ permission type when creating a workspace in the
-- CLI.
--
-- If you specify @CUSTOMER_MANAGED@, you will manage those roles and
-- permissions yourself. If you are creating this workspace in a member
-- account of an organization that is not a delegated administrator
-- account, and you want the workspace to access data sources in other
-- Amazon Web Services accounts in the organization, you must choose
-- @CUSTOMER_MANAGED@.
--
-- For more information, see
-- <https://docs.aws.amazon.com/grafana/latest/userguide/AMG-manage-permissions.html Amazon Managed Grafana permissions and policies for Amazon Web Services data sources and notification channels>.
newCreateWorkspace ::
  -- | 'accountAccessType'
  AccountAccessType ->
  -- | 'permissionType'
  PermissionType ->
  CreateWorkspace
newCreateWorkspace :: AccountAccessType -> PermissionType -> CreateWorkspace
newCreateWorkspace
  AccountAccessType
pAccountAccessType_
  PermissionType
pPermissionType_ =
    CreateWorkspace'
      { $sel:clientToken:CreateWorkspace' :: Maybe Text
clientToken = forall a. Maybe a
Prelude.Nothing,
        $sel:configuration:CreateWorkspace' :: Maybe Text
configuration = forall a. Maybe a
Prelude.Nothing,
        $sel:organizationRoleName:CreateWorkspace' :: Maybe (Sensitive Text)
organizationRoleName = forall a. Maybe a
Prelude.Nothing,
        $sel:stackSetName:CreateWorkspace' :: Maybe Text
stackSetName = forall a. Maybe a
Prelude.Nothing,
        $sel:tags:CreateWorkspace' :: Maybe (HashMap Text Text)
tags = forall a. Maybe a
Prelude.Nothing,
        $sel:vpcConfiguration:CreateWorkspace' :: Maybe VpcConfiguration
vpcConfiguration = forall a. Maybe a
Prelude.Nothing,
        $sel:workspaceDataSources:CreateWorkspace' :: Maybe [DataSourceType]
workspaceDataSources = forall a. Maybe a
Prelude.Nothing,
        $sel:workspaceDescription:CreateWorkspace' :: Maybe (Sensitive Text)
workspaceDescription = forall a. Maybe a
Prelude.Nothing,
        $sel:workspaceName:CreateWorkspace' :: Maybe (Sensitive Text)
workspaceName = forall a. Maybe a
Prelude.Nothing,
        $sel:workspaceNotificationDestinations:CreateWorkspace' :: Maybe [NotificationDestinationType]
workspaceNotificationDestinations = forall a. Maybe a
Prelude.Nothing,
        $sel:workspaceOrganizationalUnits:CreateWorkspace' :: Maybe (Sensitive [Text])
workspaceOrganizationalUnits = forall a. Maybe a
Prelude.Nothing,
        $sel:workspaceRoleArn:CreateWorkspace' :: Maybe (Sensitive Text)
workspaceRoleArn = forall a. Maybe a
Prelude.Nothing,
        $sel:accountAccessType:CreateWorkspace' :: AccountAccessType
accountAccessType = AccountAccessType
pAccountAccessType_,
        $sel:authenticationProviders:CreateWorkspace' :: [AuthenticationProviderTypes]
authenticationProviders = forall a. Monoid a => a
Prelude.mempty,
        $sel:permissionType:CreateWorkspace' :: PermissionType
permissionType = PermissionType
pPermissionType_
      }

-- | A unique, case-sensitive, user-provided identifier to ensure the
-- idempotency of the request.
createWorkspace_clientToken :: Lens.Lens' CreateWorkspace (Prelude.Maybe Prelude.Text)
createWorkspace_clientToken :: Lens' CreateWorkspace (Maybe Text)
createWorkspace_clientToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateWorkspace' {Maybe Text
clientToken :: Maybe Text
$sel:clientToken:CreateWorkspace' :: CreateWorkspace -> Maybe Text
clientToken} -> Maybe Text
clientToken) (\s :: CreateWorkspace
s@CreateWorkspace' {} Maybe Text
a -> CreateWorkspace
s {$sel:clientToken:CreateWorkspace' :: Maybe Text
clientToken = Maybe Text
a} :: CreateWorkspace)

-- | The configuration string for the workspace that you create. For more
-- information about the format and configuration options available, see
-- <https://docs.aws.amazon.com/grafana/latest/userguide/AMG-configure-workspace.html Working in your Grafana workspace>.
createWorkspace_configuration :: Lens.Lens' CreateWorkspace (Prelude.Maybe Prelude.Text)
createWorkspace_configuration :: Lens' CreateWorkspace (Maybe Text)
createWorkspace_configuration = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateWorkspace' {Maybe Text
configuration :: Maybe Text
$sel:configuration:CreateWorkspace' :: CreateWorkspace -> Maybe Text
configuration} -> Maybe Text
configuration) (\s :: CreateWorkspace
s@CreateWorkspace' {} Maybe Text
a -> CreateWorkspace
s {$sel:configuration:CreateWorkspace' :: Maybe Text
configuration = Maybe Text
a} :: CreateWorkspace)

-- | The name of an IAM role that already exists to use with Organizations to
-- access Amazon Web Services data sources and notification channels in
-- other accounts in an organization.
createWorkspace_organizationRoleName :: Lens.Lens' CreateWorkspace (Prelude.Maybe Prelude.Text)
createWorkspace_organizationRoleName :: Lens' CreateWorkspace (Maybe Text)
createWorkspace_organizationRoleName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateWorkspace' {Maybe (Sensitive Text)
organizationRoleName :: Maybe (Sensitive Text)
$sel:organizationRoleName:CreateWorkspace' :: CreateWorkspace -> Maybe (Sensitive Text)
organizationRoleName} -> Maybe (Sensitive Text)
organizationRoleName) (\s :: CreateWorkspace
s@CreateWorkspace' {} Maybe (Sensitive Text)
a -> CreateWorkspace
s {$sel:organizationRoleName:CreateWorkspace' :: Maybe (Sensitive Text)
organizationRoleName = Maybe (Sensitive Text)
a} :: CreateWorkspace) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall (f :: * -> *) (g :: * -> *) s t a b.
(Functor f, Functor g) =>
AnIso s t a b -> Iso (f s) (g t) (f a) (g b)
Lens.mapping forall a. Iso' (Sensitive a) a
Data._Sensitive

-- | The name of the CloudFormation stack set to use to generate IAM roles to
-- be used for this workspace.
createWorkspace_stackSetName :: Lens.Lens' CreateWorkspace (Prelude.Maybe Prelude.Text)
createWorkspace_stackSetName :: Lens' CreateWorkspace (Maybe Text)
createWorkspace_stackSetName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateWorkspace' {Maybe Text
stackSetName :: Maybe Text
$sel:stackSetName:CreateWorkspace' :: CreateWorkspace -> Maybe Text
stackSetName} -> Maybe Text
stackSetName) (\s :: CreateWorkspace
s@CreateWorkspace' {} Maybe Text
a -> CreateWorkspace
s {$sel:stackSetName:CreateWorkspace' :: Maybe Text
stackSetName = Maybe Text
a} :: CreateWorkspace)

-- | The list of tags associated with the workspace.
createWorkspace_tags :: Lens.Lens' CreateWorkspace (Prelude.Maybe (Prelude.HashMap Prelude.Text Prelude.Text))
createWorkspace_tags :: Lens' CreateWorkspace (Maybe (HashMap Text Text))
createWorkspace_tags = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateWorkspace' {Maybe (HashMap Text Text)
tags :: Maybe (HashMap Text Text)
$sel:tags:CreateWorkspace' :: CreateWorkspace -> Maybe (HashMap Text Text)
tags} -> Maybe (HashMap Text Text)
tags) (\s :: CreateWorkspace
s@CreateWorkspace' {} Maybe (HashMap Text Text)
a -> CreateWorkspace
s {$sel:tags:CreateWorkspace' :: Maybe (HashMap Text Text)
tags = Maybe (HashMap Text Text)
a} :: CreateWorkspace) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall (f :: * -> *) (g :: * -> *) s t a b.
(Functor f, Functor g) =>
AnIso s t a b -> Iso (f s) (g t) (f a) (g b)
Lens.mapping forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Lens.coerced

-- | The configuration settings for an Amazon VPC that contains data sources
-- for your Grafana workspace to connect to.
createWorkspace_vpcConfiguration :: Lens.Lens' CreateWorkspace (Prelude.Maybe VpcConfiguration)
createWorkspace_vpcConfiguration :: Lens' CreateWorkspace (Maybe VpcConfiguration)
createWorkspace_vpcConfiguration = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateWorkspace' {Maybe VpcConfiguration
vpcConfiguration :: Maybe VpcConfiguration
$sel:vpcConfiguration:CreateWorkspace' :: CreateWorkspace -> Maybe VpcConfiguration
vpcConfiguration} -> Maybe VpcConfiguration
vpcConfiguration) (\s :: CreateWorkspace
s@CreateWorkspace' {} Maybe VpcConfiguration
a -> CreateWorkspace
s {$sel:vpcConfiguration:CreateWorkspace' :: Maybe VpcConfiguration
vpcConfiguration = Maybe VpcConfiguration
a} :: CreateWorkspace)

-- | Specify the Amazon Web Services data sources that you want to be queried
-- in this workspace. Specifying these data sources here enables Amazon
-- Managed Grafana to create IAM roles and permissions that allow Amazon
-- Managed Grafana to read data from these sources. You must still add them
-- as data sources in the Grafana console in the workspace.
--
-- If you don\'t specify a data source here, you can still add it as a data
-- source in the workspace console later. However, you will then have to
-- manually configure permissions for it.
createWorkspace_workspaceDataSources :: Lens.Lens' CreateWorkspace (Prelude.Maybe [DataSourceType])
createWorkspace_workspaceDataSources :: Lens' CreateWorkspace (Maybe [DataSourceType])
createWorkspace_workspaceDataSources = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateWorkspace' {Maybe [DataSourceType]
workspaceDataSources :: Maybe [DataSourceType]
$sel:workspaceDataSources:CreateWorkspace' :: CreateWorkspace -> Maybe [DataSourceType]
workspaceDataSources} -> Maybe [DataSourceType]
workspaceDataSources) (\s :: CreateWorkspace
s@CreateWorkspace' {} Maybe [DataSourceType]
a -> CreateWorkspace
s {$sel:workspaceDataSources:CreateWorkspace' :: Maybe [DataSourceType]
workspaceDataSources = Maybe [DataSourceType]
a} :: CreateWorkspace) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall (f :: * -> *) (g :: * -> *) s t a b.
(Functor f, Functor g) =>
AnIso s t a b -> Iso (f s) (g t) (f a) (g b)
Lens.mapping forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Lens.coerced

-- | A description for the workspace. This is used only to help you identify
-- this workspace.
--
-- Pattern: @^[\\\\p{L}\\\\p{Z}\\\\p{N}\\\\p{P}]{0,2048}$@
createWorkspace_workspaceDescription :: Lens.Lens' CreateWorkspace (Prelude.Maybe Prelude.Text)
createWorkspace_workspaceDescription :: Lens' CreateWorkspace (Maybe Text)
createWorkspace_workspaceDescription = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateWorkspace' {Maybe (Sensitive Text)
workspaceDescription :: Maybe (Sensitive Text)
$sel:workspaceDescription:CreateWorkspace' :: CreateWorkspace -> Maybe (Sensitive Text)
workspaceDescription} -> Maybe (Sensitive Text)
workspaceDescription) (\s :: CreateWorkspace
s@CreateWorkspace' {} Maybe (Sensitive Text)
a -> CreateWorkspace
s {$sel:workspaceDescription:CreateWorkspace' :: Maybe (Sensitive Text)
workspaceDescription = Maybe (Sensitive Text)
a} :: CreateWorkspace) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall (f :: * -> *) (g :: * -> *) s t a b.
(Functor f, Functor g) =>
AnIso s t a b -> Iso (f s) (g t) (f a) (g b)
Lens.mapping forall a. Iso' (Sensitive a) a
Data._Sensitive

-- | The name for the workspace. It does not have to be unique.
createWorkspace_workspaceName :: Lens.Lens' CreateWorkspace (Prelude.Maybe Prelude.Text)
createWorkspace_workspaceName :: Lens' CreateWorkspace (Maybe Text)
createWorkspace_workspaceName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateWorkspace' {Maybe (Sensitive Text)
workspaceName :: Maybe (Sensitive Text)
$sel:workspaceName:CreateWorkspace' :: CreateWorkspace -> Maybe (Sensitive Text)
workspaceName} -> Maybe (Sensitive Text)
workspaceName) (\s :: CreateWorkspace
s@CreateWorkspace' {} Maybe (Sensitive Text)
a -> CreateWorkspace
s {$sel:workspaceName:CreateWorkspace' :: Maybe (Sensitive Text)
workspaceName = Maybe (Sensitive Text)
a} :: CreateWorkspace) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall (f :: * -> *) (g :: * -> *) s t a b.
(Functor f, Functor g) =>
AnIso s t a b -> Iso (f s) (g t) (f a) (g b)
Lens.mapping forall a. Iso' (Sensitive a) a
Data._Sensitive

-- | Specify the Amazon Web Services notification channels that you plan to
-- use in this workspace. Specifying these data sources here enables Amazon
-- Managed Grafana to create IAM roles and permissions that allow Amazon
-- Managed Grafana to use these channels.
createWorkspace_workspaceNotificationDestinations :: Lens.Lens' CreateWorkspace (Prelude.Maybe [NotificationDestinationType])
createWorkspace_workspaceNotificationDestinations :: Lens' CreateWorkspace (Maybe [NotificationDestinationType])
createWorkspace_workspaceNotificationDestinations = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateWorkspace' {Maybe [NotificationDestinationType]
workspaceNotificationDestinations :: Maybe [NotificationDestinationType]
$sel:workspaceNotificationDestinations:CreateWorkspace' :: CreateWorkspace -> Maybe [NotificationDestinationType]
workspaceNotificationDestinations} -> Maybe [NotificationDestinationType]
workspaceNotificationDestinations) (\s :: CreateWorkspace
s@CreateWorkspace' {} Maybe [NotificationDestinationType]
a -> CreateWorkspace
s {$sel:workspaceNotificationDestinations:CreateWorkspace' :: Maybe [NotificationDestinationType]
workspaceNotificationDestinations = Maybe [NotificationDestinationType]
a} :: CreateWorkspace) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall (f :: * -> *) (g :: * -> *) s t a b.
(Functor f, Functor g) =>
AnIso s t a b -> Iso (f s) (g t) (f a) (g b)
Lens.mapping forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Lens.coerced

-- | Specifies the organizational units that this workspace is allowed to use
-- data sources from, if this workspace is in an account that is part of an
-- organization.
createWorkspace_workspaceOrganizationalUnits :: Lens.Lens' CreateWorkspace (Prelude.Maybe [Prelude.Text])
createWorkspace_workspaceOrganizationalUnits :: Lens' CreateWorkspace (Maybe [Text])
createWorkspace_workspaceOrganizationalUnits = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateWorkspace' {Maybe (Sensitive [Text])
workspaceOrganizationalUnits :: Maybe (Sensitive [Text])
$sel:workspaceOrganizationalUnits:CreateWorkspace' :: CreateWorkspace -> Maybe (Sensitive [Text])
workspaceOrganizationalUnits} -> Maybe (Sensitive [Text])
workspaceOrganizationalUnits) (\s :: CreateWorkspace
s@CreateWorkspace' {} Maybe (Sensitive [Text])
a -> CreateWorkspace
s {$sel:workspaceOrganizationalUnits:CreateWorkspace' :: Maybe (Sensitive [Text])
workspaceOrganizationalUnits = Maybe (Sensitive [Text])
a} :: CreateWorkspace) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall (f :: * -> *) (g :: * -> *) s t a b.
(Functor f, Functor g) =>
AnIso s t a b -> Iso (f s) (g t) (f a) (g b)
Lens.mapping (forall a. Iso' (Sensitive a) a
Data._Sensitive forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Lens.coerced)

-- | The workspace needs an IAM role that grants permissions to the Amazon
-- Web Services resources that the workspace will view data from. If you
-- already have a role that you want to use, specify it here. The
-- permission type should be set to @CUSTOMER_MANAGED@.
createWorkspace_workspaceRoleArn :: Lens.Lens' CreateWorkspace (Prelude.Maybe Prelude.Text)
createWorkspace_workspaceRoleArn :: Lens' CreateWorkspace (Maybe Text)
createWorkspace_workspaceRoleArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateWorkspace' {Maybe (Sensitive Text)
workspaceRoleArn :: Maybe (Sensitive Text)
$sel:workspaceRoleArn:CreateWorkspace' :: CreateWorkspace -> Maybe (Sensitive Text)
workspaceRoleArn} -> Maybe (Sensitive Text)
workspaceRoleArn) (\s :: CreateWorkspace
s@CreateWorkspace' {} Maybe (Sensitive Text)
a -> CreateWorkspace
s {$sel:workspaceRoleArn:CreateWorkspace' :: Maybe (Sensitive Text)
workspaceRoleArn = Maybe (Sensitive Text)
a} :: CreateWorkspace) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall (f :: * -> *) (g :: * -> *) s t a b.
(Functor f, Functor g) =>
AnIso s t a b -> Iso (f s) (g t) (f a) (g b)
Lens.mapping forall a. Iso' (Sensitive a) a
Data._Sensitive

-- | Specifies whether the workspace can access Amazon Web Services resources
-- in this Amazon Web Services account only, or whether it can also access
-- Amazon Web Services resources in other accounts in the same
-- organization. If you specify @ORGANIZATION@, you must specify which
-- organizational units the workspace can access in the
-- @workspaceOrganizationalUnits@ parameter.
createWorkspace_accountAccessType :: Lens.Lens' CreateWorkspace AccountAccessType
createWorkspace_accountAccessType :: Lens' CreateWorkspace AccountAccessType
createWorkspace_accountAccessType = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateWorkspace' {AccountAccessType
accountAccessType :: AccountAccessType
$sel:accountAccessType:CreateWorkspace' :: CreateWorkspace -> AccountAccessType
accountAccessType} -> AccountAccessType
accountAccessType) (\s :: CreateWorkspace
s@CreateWorkspace' {} AccountAccessType
a -> CreateWorkspace
s {$sel:accountAccessType:CreateWorkspace' :: AccountAccessType
accountAccessType = AccountAccessType
a} :: CreateWorkspace)

-- | Specifies whether this workspace uses SAML 2.0, IAM Identity Center
-- (successor to Single Sign-On), or both to authenticate users for using
-- the Grafana console within a workspace. For more information, see
-- <https://docs.aws.amazon.com/grafana/latest/userguide/authentication-in-AMG.html User authentication in Amazon Managed Grafana>.
createWorkspace_authenticationProviders :: Lens.Lens' CreateWorkspace [AuthenticationProviderTypes]
createWorkspace_authenticationProviders :: Lens' CreateWorkspace [AuthenticationProviderTypes]
createWorkspace_authenticationProviders = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateWorkspace' {[AuthenticationProviderTypes]
authenticationProviders :: [AuthenticationProviderTypes]
$sel:authenticationProviders:CreateWorkspace' :: CreateWorkspace -> [AuthenticationProviderTypes]
authenticationProviders} -> [AuthenticationProviderTypes]
authenticationProviders) (\s :: CreateWorkspace
s@CreateWorkspace' {} [AuthenticationProviderTypes]
a -> CreateWorkspace
s {$sel:authenticationProviders:CreateWorkspace' :: [AuthenticationProviderTypes]
authenticationProviders = [AuthenticationProviderTypes]
a} :: CreateWorkspace) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Lens.coerced

-- | If you specify @SERVICE_MANAGED@ on AWS Grafana console, Amazon Managed
-- Grafana automatically creates the IAM roles and provisions the
-- permissions that the workspace needs to use Amazon Web Services data
-- sources and notification channels. In the CLI mode, the permissionType
-- @SERVICE_MANAGED@ will not create the IAM role for you. The ability for
-- the Amazon Managed Grafana to create the IAM role on behalf of the user
-- is supported only in the Amazon Managed Grafana AWS console. Use only
-- the @CUSTOMER_MANAGED@ permission type when creating a workspace in the
-- CLI.
--
-- If you specify @CUSTOMER_MANAGED@, you will manage those roles and
-- permissions yourself. If you are creating this workspace in a member
-- account of an organization that is not a delegated administrator
-- account, and you want the workspace to access data sources in other
-- Amazon Web Services accounts in the organization, you must choose
-- @CUSTOMER_MANAGED@.
--
-- For more information, see
-- <https://docs.aws.amazon.com/grafana/latest/userguide/AMG-manage-permissions.html Amazon Managed Grafana permissions and policies for Amazon Web Services data sources and notification channels>.
createWorkspace_permissionType :: Lens.Lens' CreateWorkspace PermissionType
createWorkspace_permissionType :: Lens' CreateWorkspace PermissionType
createWorkspace_permissionType = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateWorkspace' {PermissionType
permissionType :: PermissionType
$sel:permissionType:CreateWorkspace' :: CreateWorkspace -> PermissionType
permissionType} -> PermissionType
permissionType) (\s :: CreateWorkspace
s@CreateWorkspace' {} PermissionType
a -> CreateWorkspace
s {$sel:permissionType:CreateWorkspace' :: PermissionType
permissionType = PermissionType
a} :: CreateWorkspace)

instance Core.AWSRequest CreateWorkspace where
  type
    AWSResponse CreateWorkspace =
      CreateWorkspaceResponse
  request :: (Service -> Service) -> CreateWorkspace -> Request CreateWorkspace
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 CreateWorkspace
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse CreateWorkspace)))
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 ->
          Int -> WorkspaceDescription -> CreateWorkspaceResponse
CreateWorkspaceResponse'
            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))
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String a
Data..:> Key
"workspace")
      )

instance Prelude.Hashable CreateWorkspace where
  hashWithSalt :: Int -> CreateWorkspace -> Int
hashWithSalt Int
_salt CreateWorkspace' {[AuthenticationProviderTypes]
Maybe [DataSourceType]
Maybe [NotificationDestinationType]
Maybe Text
Maybe (HashMap Text Text)
Maybe (Sensitive [Text])
Maybe (Sensitive Text)
Maybe VpcConfiguration
AccountAccessType
PermissionType
permissionType :: PermissionType
authenticationProviders :: [AuthenticationProviderTypes]
accountAccessType :: AccountAccessType
workspaceRoleArn :: Maybe (Sensitive Text)
workspaceOrganizationalUnits :: Maybe (Sensitive [Text])
workspaceNotificationDestinations :: Maybe [NotificationDestinationType]
workspaceName :: Maybe (Sensitive Text)
workspaceDescription :: Maybe (Sensitive Text)
workspaceDataSources :: Maybe [DataSourceType]
vpcConfiguration :: Maybe VpcConfiguration
tags :: Maybe (HashMap Text Text)
stackSetName :: Maybe Text
organizationRoleName :: Maybe (Sensitive Text)
configuration :: Maybe Text
clientToken :: Maybe Text
$sel:permissionType:CreateWorkspace' :: CreateWorkspace -> PermissionType
$sel:authenticationProviders:CreateWorkspace' :: CreateWorkspace -> [AuthenticationProviderTypes]
$sel:accountAccessType:CreateWorkspace' :: CreateWorkspace -> AccountAccessType
$sel:workspaceRoleArn:CreateWorkspace' :: CreateWorkspace -> Maybe (Sensitive Text)
$sel:workspaceOrganizationalUnits:CreateWorkspace' :: CreateWorkspace -> Maybe (Sensitive [Text])
$sel:workspaceNotificationDestinations:CreateWorkspace' :: CreateWorkspace -> Maybe [NotificationDestinationType]
$sel:workspaceName:CreateWorkspace' :: CreateWorkspace -> Maybe (Sensitive Text)
$sel:workspaceDescription:CreateWorkspace' :: CreateWorkspace -> Maybe (Sensitive Text)
$sel:workspaceDataSources:CreateWorkspace' :: CreateWorkspace -> Maybe [DataSourceType]
$sel:vpcConfiguration:CreateWorkspace' :: CreateWorkspace -> Maybe VpcConfiguration
$sel:tags:CreateWorkspace' :: CreateWorkspace -> Maybe (HashMap Text Text)
$sel:stackSetName:CreateWorkspace' :: CreateWorkspace -> Maybe Text
$sel:organizationRoleName:CreateWorkspace' :: CreateWorkspace -> Maybe (Sensitive Text)
$sel:configuration:CreateWorkspace' :: CreateWorkspace -> Maybe Text
$sel:clientToken:CreateWorkspace' :: CreateWorkspace -> Maybe Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
clientToken
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
configuration
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe (Sensitive Text)
organizationRoleName
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
stackSetName
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe (HashMap Text Text)
tags
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe VpcConfiguration
vpcConfiguration
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [DataSourceType]
workspaceDataSources
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe (Sensitive Text)
workspaceDescription
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe (Sensitive Text)
workspaceName
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [NotificationDestinationType]
workspaceNotificationDestinations
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe (Sensitive [Text])
workspaceOrganizationalUnits
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe (Sensitive Text)
workspaceRoleArn
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` AccountAccessType
accountAccessType
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` [AuthenticationProviderTypes]
authenticationProviders
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` PermissionType
permissionType

instance Prelude.NFData CreateWorkspace where
  rnf :: CreateWorkspace -> ()
rnf CreateWorkspace' {[AuthenticationProviderTypes]
Maybe [DataSourceType]
Maybe [NotificationDestinationType]
Maybe Text
Maybe (HashMap Text Text)
Maybe (Sensitive [Text])
Maybe (Sensitive Text)
Maybe VpcConfiguration
AccountAccessType
PermissionType
permissionType :: PermissionType
authenticationProviders :: [AuthenticationProviderTypes]
accountAccessType :: AccountAccessType
workspaceRoleArn :: Maybe (Sensitive Text)
workspaceOrganizationalUnits :: Maybe (Sensitive [Text])
workspaceNotificationDestinations :: Maybe [NotificationDestinationType]
workspaceName :: Maybe (Sensitive Text)
workspaceDescription :: Maybe (Sensitive Text)
workspaceDataSources :: Maybe [DataSourceType]
vpcConfiguration :: Maybe VpcConfiguration
tags :: Maybe (HashMap Text Text)
stackSetName :: Maybe Text
organizationRoleName :: Maybe (Sensitive Text)
configuration :: Maybe Text
clientToken :: Maybe Text
$sel:permissionType:CreateWorkspace' :: CreateWorkspace -> PermissionType
$sel:authenticationProviders:CreateWorkspace' :: CreateWorkspace -> [AuthenticationProviderTypes]
$sel:accountAccessType:CreateWorkspace' :: CreateWorkspace -> AccountAccessType
$sel:workspaceRoleArn:CreateWorkspace' :: CreateWorkspace -> Maybe (Sensitive Text)
$sel:workspaceOrganizationalUnits:CreateWorkspace' :: CreateWorkspace -> Maybe (Sensitive [Text])
$sel:workspaceNotificationDestinations:CreateWorkspace' :: CreateWorkspace -> Maybe [NotificationDestinationType]
$sel:workspaceName:CreateWorkspace' :: CreateWorkspace -> Maybe (Sensitive Text)
$sel:workspaceDescription:CreateWorkspace' :: CreateWorkspace -> Maybe (Sensitive Text)
$sel:workspaceDataSources:CreateWorkspace' :: CreateWorkspace -> Maybe [DataSourceType]
$sel:vpcConfiguration:CreateWorkspace' :: CreateWorkspace -> Maybe VpcConfiguration
$sel:tags:CreateWorkspace' :: CreateWorkspace -> Maybe (HashMap Text Text)
$sel:stackSetName:CreateWorkspace' :: CreateWorkspace -> Maybe Text
$sel:organizationRoleName:CreateWorkspace' :: CreateWorkspace -> Maybe (Sensitive Text)
$sel:configuration:CreateWorkspace' :: CreateWorkspace -> Maybe Text
$sel:clientToken:CreateWorkspace' :: CreateWorkspace -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
clientToken
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
configuration
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe (Sensitive Text)
organizationRoleName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
stackSetName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe (HashMap Text Text)
tags
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe VpcConfiguration
vpcConfiguration
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [DataSourceType]
workspaceDataSources
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe (Sensitive Text)
workspaceDescription
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe (Sensitive Text)
workspaceName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [NotificationDestinationType]
workspaceNotificationDestinations
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe (Sensitive [Text])
workspaceOrganizationalUnits
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe (Sensitive Text)
workspaceRoleArn
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf AccountAccessType
accountAccessType
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf [AuthenticationProviderTypes]
authenticationProviders
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf PermissionType
permissionType

instance Data.ToHeaders CreateWorkspace where
  toHeaders :: CreateWorkspace -> 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 CreateWorkspace where
  toJSON :: CreateWorkspace -> Value
toJSON CreateWorkspace' {[AuthenticationProviderTypes]
Maybe [DataSourceType]
Maybe [NotificationDestinationType]
Maybe Text
Maybe (HashMap Text Text)
Maybe (Sensitive [Text])
Maybe (Sensitive Text)
Maybe VpcConfiguration
AccountAccessType
PermissionType
permissionType :: PermissionType
authenticationProviders :: [AuthenticationProviderTypes]
accountAccessType :: AccountAccessType
workspaceRoleArn :: Maybe (Sensitive Text)
workspaceOrganizationalUnits :: Maybe (Sensitive [Text])
workspaceNotificationDestinations :: Maybe [NotificationDestinationType]
workspaceName :: Maybe (Sensitive Text)
workspaceDescription :: Maybe (Sensitive Text)
workspaceDataSources :: Maybe [DataSourceType]
vpcConfiguration :: Maybe VpcConfiguration
tags :: Maybe (HashMap Text Text)
stackSetName :: Maybe Text
organizationRoleName :: Maybe (Sensitive Text)
configuration :: Maybe Text
clientToken :: Maybe Text
$sel:permissionType:CreateWorkspace' :: CreateWorkspace -> PermissionType
$sel:authenticationProviders:CreateWorkspace' :: CreateWorkspace -> [AuthenticationProviderTypes]
$sel:accountAccessType:CreateWorkspace' :: CreateWorkspace -> AccountAccessType
$sel:workspaceRoleArn:CreateWorkspace' :: CreateWorkspace -> Maybe (Sensitive Text)
$sel:workspaceOrganizationalUnits:CreateWorkspace' :: CreateWorkspace -> Maybe (Sensitive [Text])
$sel:workspaceNotificationDestinations:CreateWorkspace' :: CreateWorkspace -> Maybe [NotificationDestinationType]
$sel:workspaceName:CreateWorkspace' :: CreateWorkspace -> Maybe (Sensitive Text)
$sel:workspaceDescription:CreateWorkspace' :: CreateWorkspace -> Maybe (Sensitive Text)
$sel:workspaceDataSources:CreateWorkspace' :: CreateWorkspace -> Maybe [DataSourceType]
$sel:vpcConfiguration:CreateWorkspace' :: CreateWorkspace -> Maybe VpcConfiguration
$sel:tags:CreateWorkspace' :: CreateWorkspace -> Maybe (HashMap Text Text)
$sel:stackSetName:CreateWorkspace' :: CreateWorkspace -> Maybe Text
$sel:organizationRoleName:CreateWorkspace' :: CreateWorkspace -> Maybe (Sensitive Text)
$sel:configuration:CreateWorkspace' :: CreateWorkspace -> Maybe Text
$sel:clientToken:CreateWorkspace' :: CreateWorkspace -> Maybe Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"clientToken" 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
clientToken,
            (Key
"configuration" 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
configuration,
            (Key
"organizationRoleName" 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 (Sensitive Text)
organizationRoleName,
            (Key
"stackSetName" 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
stackSetName,
            (Key
"tags" 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 (HashMap Text Text)
tags,
            (Key
"vpcConfiguration" 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 VpcConfiguration
vpcConfiguration,
            (Key
"workspaceDataSources" 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 [DataSourceType]
workspaceDataSources,
            (Key
"workspaceDescription" 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 (Sensitive Text)
workspaceDescription,
            (Key
"workspaceName" 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 (Sensitive Text)
workspaceName,
            (Key
"workspaceNotificationDestinations" 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 [NotificationDestinationType]
workspaceNotificationDestinations,
            (Key
"workspaceOrganizationalUnits" 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 (Sensitive [Text])
workspaceOrganizationalUnits,
            (Key
"workspaceRoleArn" 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 (Sensitive Text)
workspaceRoleArn,
            forall a. a -> Maybe a
Prelude.Just
              (Key
"accountAccessType" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= AccountAccessType
accountAccessType),
            forall a. a -> Maybe a
Prelude.Just
              ( Key
"authenticationProviders"
                  forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= [AuthenticationProviderTypes]
authenticationProviders
              ),
            forall a. a -> Maybe a
Prelude.Just
              (Key
"permissionType" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= PermissionType
permissionType)
          ]
      )

instance Data.ToPath CreateWorkspace where
  toPath :: CreateWorkspace -> ByteString
toPath = forall a b. a -> b -> a
Prelude.const ByteString
"/workspaces"

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

-- | /See:/ 'newCreateWorkspaceResponse' smart constructor.
data CreateWorkspaceResponse = CreateWorkspaceResponse'
  { -- | The response's http status code.
    CreateWorkspaceResponse -> Int
httpStatus :: Prelude.Int,
    -- | A structure containing data about the workspace that was created.
    CreateWorkspaceResponse -> WorkspaceDescription
workspace :: WorkspaceDescription
  }
  deriving (CreateWorkspaceResponse -> CreateWorkspaceResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateWorkspaceResponse -> CreateWorkspaceResponse -> Bool
$c/= :: CreateWorkspaceResponse -> CreateWorkspaceResponse -> Bool
== :: CreateWorkspaceResponse -> CreateWorkspaceResponse -> Bool
$c== :: CreateWorkspaceResponse -> CreateWorkspaceResponse -> Bool
Prelude.Eq, Int -> CreateWorkspaceResponse -> ShowS
[CreateWorkspaceResponse] -> ShowS
CreateWorkspaceResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateWorkspaceResponse] -> ShowS
$cshowList :: [CreateWorkspaceResponse] -> ShowS
show :: CreateWorkspaceResponse -> String
$cshow :: CreateWorkspaceResponse -> String
showsPrec :: Int -> CreateWorkspaceResponse -> ShowS
$cshowsPrec :: Int -> CreateWorkspaceResponse -> ShowS
Prelude.Show, forall x. Rep CreateWorkspaceResponse x -> CreateWorkspaceResponse
forall x. CreateWorkspaceResponse -> Rep CreateWorkspaceResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CreateWorkspaceResponse x -> CreateWorkspaceResponse
$cfrom :: forall x. CreateWorkspaceResponse -> Rep CreateWorkspaceResponse x
Prelude.Generic)

-- |
-- Create a value of 'CreateWorkspaceResponse' 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', 'createWorkspaceResponse_httpStatus' - The response's http status code.
--
-- 'workspace', 'createWorkspaceResponse_workspace' - A structure containing data about the workspace that was created.
newCreateWorkspaceResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  -- | 'workspace'
  WorkspaceDescription ->
  CreateWorkspaceResponse
newCreateWorkspaceResponse :: Int -> WorkspaceDescription -> CreateWorkspaceResponse
newCreateWorkspaceResponse Int
pHttpStatus_ WorkspaceDescription
pWorkspace_ =
  CreateWorkspaceResponse'
    { $sel:httpStatus:CreateWorkspaceResponse' :: Int
httpStatus = Int
pHttpStatus_,
      $sel:workspace:CreateWorkspaceResponse' :: WorkspaceDescription
workspace = WorkspaceDescription
pWorkspace_
    }

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

-- | A structure containing data about the workspace that was created.
createWorkspaceResponse_workspace :: Lens.Lens' CreateWorkspaceResponse WorkspaceDescription
createWorkspaceResponse_workspace :: Lens' CreateWorkspaceResponse WorkspaceDescription
createWorkspaceResponse_workspace = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateWorkspaceResponse' {WorkspaceDescription
workspace :: WorkspaceDescription
$sel:workspace:CreateWorkspaceResponse' :: CreateWorkspaceResponse -> WorkspaceDescription
workspace} -> WorkspaceDescription
workspace) (\s :: CreateWorkspaceResponse
s@CreateWorkspaceResponse' {} WorkspaceDescription
a -> CreateWorkspaceResponse
s {$sel:workspace:CreateWorkspaceResponse' :: WorkspaceDescription
workspace = WorkspaceDescription
a} :: CreateWorkspaceResponse)

instance Prelude.NFData CreateWorkspaceResponse where
  rnf :: CreateWorkspaceResponse -> ()
rnf CreateWorkspaceResponse' {Int
WorkspaceDescription
workspace :: WorkspaceDescription
httpStatus :: Int
$sel:workspace:CreateWorkspaceResponse' :: CreateWorkspaceResponse -> WorkspaceDescription
$sel:httpStatus:CreateWorkspaceResponse' :: CreateWorkspaceResponse -> Int
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf WorkspaceDescription
workspace