{-# 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.EMR.CreateStudio
-- 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 new Amazon EMR Studio.
module Amazonka.EMR.CreateStudio
  ( -- * Creating a Request
    CreateStudio (..),
    newCreateStudio,

    -- * Request Lenses
    createStudio_description,
    createStudio_idpAuthUrl,
    createStudio_idpRelayStateParameterName,
    createStudio_tags,
    createStudio_userRole,
    createStudio_name,
    createStudio_authMode,
    createStudio_vpcId,
    createStudio_subnetIds,
    createStudio_serviceRole,
    createStudio_workspaceSecurityGroupId,
    createStudio_engineSecurityGroupId,
    createStudio_defaultS3Location,

    -- * Destructuring the Response
    CreateStudioResponse (..),
    newCreateStudioResponse,

    -- * Response Lenses
    createStudioResponse_studioId,
    createStudioResponse_url,
    createStudioResponse_httpStatus,
  )
where

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

-- | /See:/ 'newCreateStudio' smart constructor.
data CreateStudio = CreateStudio'
  { -- | A detailed description of the Amazon EMR Studio.
    CreateStudio -> Maybe Text
description :: Prelude.Maybe Prelude.Text,
    -- | The authentication endpoint of your identity provider (IdP). Specify
    -- this value when you use IAM authentication and want to let federated
    -- users log in to a Studio with the Studio URL and credentials from your
    -- IdP. Amazon EMR Studio redirects users to this endpoint to enter
    -- credentials.
    CreateStudio -> Maybe Text
idpAuthUrl :: Prelude.Maybe Prelude.Text,
    -- | The name that your identity provider (IdP) uses for its @RelayState@
    -- parameter. For example, @RelayState@ or @TargetSource@. Specify this
    -- value when you use IAM authentication and want to let federated users
    -- log in to a Studio using the Studio URL. The @RelayState@ parameter
    -- differs by IdP.
    CreateStudio -> Maybe Text
idpRelayStateParameterName :: Prelude.Maybe Prelude.Text,
    -- | A list of tags to associate with the Amazon EMR Studio. Tags are
    -- user-defined key-value pairs that consist of a required key string with
    -- a maximum of 128 characters, and an optional value string with a maximum
    -- of 256 characters.
    CreateStudio -> Maybe [Tag]
tags :: Prelude.Maybe [Tag],
    -- | The IAM user role that users and groups assume when logged in to an
    -- Amazon EMR Studio. Only specify a @UserRole@ when you use IAM Identity
    -- Center authentication. The permissions attached to the @UserRole@ can be
    -- scoped down for each user or group using session policies.
    CreateStudio -> Maybe Text
userRole :: Prelude.Maybe Prelude.Text,
    -- | A descriptive name for the Amazon EMR Studio.
    CreateStudio -> Text
name :: Prelude.Text,
    -- | Specifies whether the Studio authenticates users using IAM or IAM
    -- Identity Center.
    CreateStudio -> AuthMode
authMode :: AuthMode,
    -- | The ID of the Amazon Virtual Private Cloud (Amazon VPC) to associate
    -- with the Studio.
    CreateStudio -> Text
vpcId :: Prelude.Text,
    -- | A list of subnet IDs to associate with the Amazon EMR Studio. A Studio
    -- can have a maximum of 5 subnets. The subnets must belong to the VPC
    -- specified by @VpcId@. Studio users can create a Workspace in any of the
    -- specified subnets.
    CreateStudio -> [Text]
subnetIds :: [Prelude.Text],
    -- | The IAM role that the Amazon EMR Studio assumes. The service role
    -- provides a way for Amazon EMR Studio to interoperate with other Amazon
    -- Web Services services.
    CreateStudio -> Text
serviceRole :: Prelude.Text,
    -- | The ID of the Amazon EMR Studio Workspace security group. The Workspace
    -- security group allows outbound network traffic to resources in the
    -- Engine security group, and it must be in the same VPC specified by
    -- @VpcId@.
    CreateStudio -> Text
workspaceSecurityGroupId :: Prelude.Text,
    -- | The ID of the Amazon EMR Studio Engine security group. The Engine
    -- security group allows inbound network traffic from the Workspace
    -- security group, and it must be in the same VPC specified by @VpcId@.
    CreateStudio -> Text
engineSecurityGroupId :: Prelude.Text,
    -- | The Amazon S3 location to back up Amazon EMR Studio Workspaces and
    -- notebook files.
    CreateStudio -> Text
defaultS3Location :: Prelude.Text
  }
  deriving (CreateStudio -> CreateStudio -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateStudio -> CreateStudio -> Bool
$c/= :: CreateStudio -> CreateStudio -> Bool
== :: CreateStudio -> CreateStudio -> Bool
$c== :: CreateStudio -> CreateStudio -> Bool
Prelude.Eq, ReadPrec [CreateStudio]
ReadPrec CreateStudio
Int -> ReadS CreateStudio
ReadS [CreateStudio]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CreateStudio]
$creadListPrec :: ReadPrec [CreateStudio]
readPrec :: ReadPrec CreateStudio
$creadPrec :: ReadPrec CreateStudio
readList :: ReadS [CreateStudio]
$creadList :: ReadS [CreateStudio]
readsPrec :: Int -> ReadS CreateStudio
$creadsPrec :: Int -> ReadS CreateStudio
Prelude.Read, Int -> CreateStudio -> ShowS
[CreateStudio] -> ShowS
CreateStudio -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateStudio] -> ShowS
$cshowList :: [CreateStudio] -> ShowS
show :: CreateStudio -> String
$cshow :: CreateStudio -> String
showsPrec :: Int -> CreateStudio -> ShowS
$cshowsPrec :: Int -> CreateStudio -> ShowS
Prelude.Show, forall x. Rep CreateStudio x -> CreateStudio
forall x. CreateStudio -> Rep CreateStudio x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CreateStudio x -> CreateStudio
$cfrom :: forall x. CreateStudio -> Rep CreateStudio x
Prelude.Generic)

-- |
-- Create a value of 'CreateStudio' 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:
--
-- 'description', 'createStudio_description' - A detailed description of the Amazon EMR Studio.
--
-- 'idpAuthUrl', 'createStudio_idpAuthUrl' - The authentication endpoint of your identity provider (IdP). Specify
-- this value when you use IAM authentication and want to let federated
-- users log in to a Studio with the Studio URL and credentials from your
-- IdP. Amazon EMR Studio redirects users to this endpoint to enter
-- credentials.
--
-- 'idpRelayStateParameterName', 'createStudio_idpRelayStateParameterName' - The name that your identity provider (IdP) uses for its @RelayState@
-- parameter. For example, @RelayState@ or @TargetSource@. Specify this
-- value when you use IAM authentication and want to let federated users
-- log in to a Studio using the Studio URL. The @RelayState@ parameter
-- differs by IdP.
--
-- 'tags', 'createStudio_tags' - A list of tags to associate with the Amazon EMR Studio. Tags are
-- user-defined key-value pairs that consist of a required key string with
-- a maximum of 128 characters, and an optional value string with a maximum
-- of 256 characters.
--
-- 'userRole', 'createStudio_userRole' - The IAM user role that users and groups assume when logged in to an
-- Amazon EMR Studio. Only specify a @UserRole@ when you use IAM Identity
-- Center authentication. The permissions attached to the @UserRole@ can be
-- scoped down for each user or group using session policies.
--
-- 'name', 'createStudio_name' - A descriptive name for the Amazon EMR Studio.
--
-- 'authMode', 'createStudio_authMode' - Specifies whether the Studio authenticates users using IAM or IAM
-- Identity Center.
--
-- 'vpcId', 'createStudio_vpcId' - The ID of the Amazon Virtual Private Cloud (Amazon VPC) to associate
-- with the Studio.
--
-- 'subnetIds', 'createStudio_subnetIds' - A list of subnet IDs to associate with the Amazon EMR Studio. A Studio
-- can have a maximum of 5 subnets. The subnets must belong to the VPC
-- specified by @VpcId@. Studio users can create a Workspace in any of the
-- specified subnets.
--
-- 'serviceRole', 'createStudio_serviceRole' - The IAM role that the Amazon EMR Studio assumes. The service role
-- provides a way for Amazon EMR Studio to interoperate with other Amazon
-- Web Services services.
--
-- 'workspaceSecurityGroupId', 'createStudio_workspaceSecurityGroupId' - The ID of the Amazon EMR Studio Workspace security group. The Workspace
-- security group allows outbound network traffic to resources in the
-- Engine security group, and it must be in the same VPC specified by
-- @VpcId@.
--
-- 'engineSecurityGroupId', 'createStudio_engineSecurityGroupId' - The ID of the Amazon EMR Studio Engine security group. The Engine
-- security group allows inbound network traffic from the Workspace
-- security group, and it must be in the same VPC specified by @VpcId@.
--
-- 'defaultS3Location', 'createStudio_defaultS3Location' - The Amazon S3 location to back up Amazon EMR Studio Workspaces and
-- notebook files.
newCreateStudio ::
  -- | 'name'
  Prelude.Text ->
  -- | 'authMode'
  AuthMode ->
  -- | 'vpcId'
  Prelude.Text ->
  -- | 'serviceRole'
  Prelude.Text ->
  -- | 'workspaceSecurityGroupId'
  Prelude.Text ->
  -- | 'engineSecurityGroupId'
  Prelude.Text ->
  -- | 'defaultS3Location'
  Prelude.Text ->
  CreateStudio
newCreateStudio :: Text
-> AuthMode -> Text -> Text -> Text -> Text -> Text -> CreateStudio
newCreateStudio
  Text
pName_
  AuthMode
pAuthMode_
  Text
pVpcId_
  Text
pServiceRole_
  Text
pWorkspaceSecurityGroupId_
  Text
pEngineSecurityGroupId_
  Text
pDefaultS3Location_ =
    CreateStudio'
      { $sel:description:CreateStudio' :: Maybe Text
description = forall a. Maybe a
Prelude.Nothing,
        $sel:idpAuthUrl:CreateStudio' :: Maybe Text
idpAuthUrl = forall a. Maybe a
Prelude.Nothing,
        $sel:idpRelayStateParameterName:CreateStudio' :: Maybe Text
idpRelayStateParameterName = forall a. Maybe a
Prelude.Nothing,
        $sel:tags:CreateStudio' :: Maybe [Tag]
tags = forall a. Maybe a
Prelude.Nothing,
        $sel:userRole:CreateStudio' :: Maybe Text
userRole = forall a. Maybe a
Prelude.Nothing,
        $sel:name:CreateStudio' :: Text
name = Text
pName_,
        $sel:authMode:CreateStudio' :: AuthMode
authMode = AuthMode
pAuthMode_,
        $sel:vpcId:CreateStudio' :: Text
vpcId = Text
pVpcId_,
        $sel:subnetIds:CreateStudio' :: [Text]
subnetIds = forall a. Monoid a => a
Prelude.mempty,
        $sel:serviceRole:CreateStudio' :: Text
serviceRole = Text
pServiceRole_,
        $sel:workspaceSecurityGroupId:CreateStudio' :: Text
workspaceSecurityGroupId =
          Text
pWorkspaceSecurityGroupId_,
        $sel:engineSecurityGroupId:CreateStudio' :: Text
engineSecurityGroupId = Text
pEngineSecurityGroupId_,
        $sel:defaultS3Location:CreateStudio' :: Text
defaultS3Location = Text
pDefaultS3Location_
      }

-- | A detailed description of the Amazon EMR Studio.
createStudio_description :: Lens.Lens' CreateStudio (Prelude.Maybe Prelude.Text)
createStudio_description :: Lens' CreateStudio (Maybe Text)
createStudio_description = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateStudio' {Maybe Text
description :: Maybe Text
$sel:description:CreateStudio' :: CreateStudio -> Maybe Text
description} -> Maybe Text
description) (\s :: CreateStudio
s@CreateStudio' {} Maybe Text
a -> CreateStudio
s {$sel:description:CreateStudio' :: Maybe Text
description = Maybe Text
a} :: CreateStudio)

-- | The authentication endpoint of your identity provider (IdP). Specify
-- this value when you use IAM authentication and want to let federated
-- users log in to a Studio with the Studio URL and credentials from your
-- IdP. Amazon EMR Studio redirects users to this endpoint to enter
-- credentials.
createStudio_idpAuthUrl :: Lens.Lens' CreateStudio (Prelude.Maybe Prelude.Text)
createStudio_idpAuthUrl :: Lens' CreateStudio (Maybe Text)
createStudio_idpAuthUrl = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateStudio' {Maybe Text
idpAuthUrl :: Maybe Text
$sel:idpAuthUrl:CreateStudio' :: CreateStudio -> Maybe Text
idpAuthUrl} -> Maybe Text
idpAuthUrl) (\s :: CreateStudio
s@CreateStudio' {} Maybe Text
a -> CreateStudio
s {$sel:idpAuthUrl:CreateStudio' :: Maybe Text
idpAuthUrl = Maybe Text
a} :: CreateStudio)

-- | The name that your identity provider (IdP) uses for its @RelayState@
-- parameter. For example, @RelayState@ or @TargetSource@. Specify this
-- value when you use IAM authentication and want to let federated users
-- log in to a Studio using the Studio URL. The @RelayState@ parameter
-- differs by IdP.
createStudio_idpRelayStateParameterName :: Lens.Lens' CreateStudio (Prelude.Maybe Prelude.Text)
createStudio_idpRelayStateParameterName :: Lens' CreateStudio (Maybe Text)
createStudio_idpRelayStateParameterName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateStudio' {Maybe Text
idpRelayStateParameterName :: Maybe Text
$sel:idpRelayStateParameterName:CreateStudio' :: CreateStudio -> Maybe Text
idpRelayStateParameterName} -> Maybe Text
idpRelayStateParameterName) (\s :: CreateStudio
s@CreateStudio' {} Maybe Text
a -> CreateStudio
s {$sel:idpRelayStateParameterName:CreateStudio' :: Maybe Text
idpRelayStateParameterName = Maybe Text
a} :: CreateStudio)

-- | A list of tags to associate with the Amazon EMR Studio. Tags are
-- user-defined key-value pairs that consist of a required key string with
-- a maximum of 128 characters, and an optional value string with a maximum
-- of 256 characters.
createStudio_tags :: Lens.Lens' CreateStudio (Prelude.Maybe [Tag])
createStudio_tags :: Lens' CreateStudio (Maybe [Tag])
createStudio_tags = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateStudio' {Maybe [Tag]
tags :: Maybe [Tag]
$sel:tags:CreateStudio' :: CreateStudio -> Maybe [Tag]
tags} -> Maybe [Tag]
tags) (\s :: CreateStudio
s@CreateStudio' {} Maybe [Tag]
a -> CreateStudio
s {$sel:tags:CreateStudio' :: Maybe [Tag]
tags = Maybe [Tag]
a} :: CreateStudio) 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 IAM user role that users and groups assume when logged in to an
-- Amazon EMR Studio. Only specify a @UserRole@ when you use IAM Identity
-- Center authentication. The permissions attached to the @UserRole@ can be
-- scoped down for each user or group using session policies.
createStudio_userRole :: Lens.Lens' CreateStudio (Prelude.Maybe Prelude.Text)
createStudio_userRole :: Lens' CreateStudio (Maybe Text)
createStudio_userRole = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateStudio' {Maybe Text
userRole :: Maybe Text
$sel:userRole:CreateStudio' :: CreateStudio -> Maybe Text
userRole} -> Maybe Text
userRole) (\s :: CreateStudio
s@CreateStudio' {} Maybe Text
a -> CreateStudio
s {$sel:userRole:CreateStudio' :: Maybe Text
userRole = Maybe Text
a} :: CreateStudio)

-- | A descriptive name for the Amazon EMR Studio.
createStudio_name :: Lens.Lens' CreateStudio Prelude.Text
createStudio_name :: Lens' CreateStudio Text
createStudio_name = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateStudio' {Text
name :: Text
$sel:name:CreateStudio' :: CreateStudio -> Text
name} -> Text
name) (\s :: CreateStudio
s@CreateStudio' {} Text
a -> CreateStudio
s {$sel:name:CreateStudio' :: Text
name = Text
a} :: CreateStudio)

-- | Specifies whether the Studio authenticates users using IAM or IAM
-- Identity Center.
createStudio_authMode :: Lens.Lens' CreateStudio AuthMode
createStudio_authMode :: Lens' CreateStudio AuthMode
createStudio_authMode = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateStudio' {AuthMode
authMode :: AuthMode
$sel:authMode:CreateStudio' :: CreateStudio -> AuthMode
authMode} -> AuthMode
authMode) (\s :: CreateStudio
s@CreateStudio' {} AuthMode
a -> CreateStudio
s {$sel:authMode:CreateStudio' :: AuthMode
authMode = AuthMode
a} :: CreateStudio)

-- | The ID of the Amazon Virtual Private Cloud (Amazon VPC) to associate
-- with the Studio.
createStudio_vpcId :: Lens.Lens' CreateStudio Prelude.Text
createStudio_vpcId :: Lens' CreateStudio Text
createStudio_vpcId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateStudio' {Text
vpcId :: Text
$sel:vpcId:CreateStudio' :: CreateStudio -> Text
vpcId} -> Text
vpcId) (\s :: CreateStudio
s@CreateStudio' {} Text
a -> CreateStudio
s {$sel:vpcId:CreateStudio' :: Text
vpcId = Text
a} :: CreateStudio)

-- | A list of subnet IDs to associate with the Amazon EMR Studio. A Studio
-- can have a maximum of 5 subnets. The subnets must belong to the VPC
-- specified by @VpcId@. Studio users can create a Workspace in any of the
-- specified subnets.
createStudio_subnetIds :: Lens.Lens' CreateStudio [Prelude.Text]
createStudio_subnetIds :: Lens' CreateStudio [Text]
createStudio_subnetIds = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateStudio' {[Text]
subnetIds :: [Text]
$sel:subnetIds:CreateStudio' :: CreateStudio -> [Text]
subnetIds} -> [Text]
subnetIds) (\s :: CreateStudio
s@CreateStudio' {} [Text]
a -> CreateStudio
s {$sel:subnetIds:CreateStudio' :: [Text]
subnetIds = [Text]
a} :: CreateStudio) 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 IAM role that the Amazon EMR Studio assumes. The service role
-- provides a way for Amazon EMR Studio to interoperate with other Amazon
-- Web Services services.
createStudio_serviceRole :: Lens.Lens' CreateStudio Prelude.Text
createStudio_serviceRole :: Lens' CreateStudio Text
createStudio_serviceRole = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateStudio' {Text
serviceRole :: Text
$sel:serviceRole:CreateStudio' :: CreateStudio -> Text
serviceRole} -> Text
serviceRole) (\s :: CreateStudio
s@CreateStudio' {} Text
a -> CreateStudio
s {$sel:serviceRole:CreateStudio' :: Text
serviceRole = Text
a} :: CreateStudio)

-- | The ID of the Amazon EMR Studio Workspace security group. The Workspace
-- security group allows outbound network traffic to resources in the
-- Engine security group, and it must be in the same VPC specified by
-- @VpcId@.
createStudio_workspaceSecurityGroupId :: Lens.Lens' CreateStudio Prelude.Text
createStudio_workspaceSecurityGroupId :: Lens' CreateStudio Text
createStudio_workspaceSecurityGroupId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateStudio' {Text
workspaceSecurityGroupId :: Text
$sel:workspaceSecurityGroupId:CreateStudio' :: CreateStudio -> Text
workspaceSecurityGroupId} -> Text
workspaceSecurityGroupId) (\s :: CreateStudio
s@CreateStudio' {} Text
a -> CreateStudio
s {$sel:workspaceSecurityGroupId:CreateStudio' :: Text
workspaceSecurityGroupId = Text
a} :: CreateStudio)

-- | The ID of the Amazon EMR Studio Engine security group. The Engine
-- security group allows inbound network traffic from the Workspace
-- security group, and it must be in the same VPC specified by @VpcId@.
createStudio_engineSecurityGroupId :: Lens.Lens' CreateStudio Prelude.Text
createStudio_engineSecurityGroupId :: Lens' CreateStudio Text
createStudio_engineSecurityGroupId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateStudio' {Text
engineSecurityGroupId :: Text
$sel:engineSecurityGroupId:CreateStudio' :: CreateStudio -> Text
engineSecurityGroupId} -> Text
engineSecurityGroupId) (\s :: CreateStudio
s@CreateStudio' {} Text
a -> CreateStudio
s {$sel:engineSecurityGroupId:CreateStudio' :: Text
engineSecurityGroupId = Text
a} :: CreateStudio)

-- | The Amazon S3 location to back up Amazon EMR Studio Workspaces and
-- notebook files.
createStudio_defaultS3Location :: Lens.Lens' CreateStudio Prelude.Text
createStudio_defaultS3Location :: Lens' CreateStudio Text
createStudio_defaultS3Location = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateStudio' {Text
defaultS3Location :: Text
$sel:defaultS3Location:CreateStudio' :: CreateStudio -> Text
defaultS3Location} -> Text
defaultS3Location) (\s :: CreateStudio
s@CreateStudio' {} Text
a -> CreateStudio
s {$sel:defaultS3Location:CreateStudio' :: Text
defaultS3Location = Text
a} :: CreateStudio)

instance Core.AWSRequest CreateStudio where
  type AWSResponse CreateStudio = CreateStudioResponse
  request :: (Service -> Service) -> CreateStudio -> Request CreateStudio
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 CreateStudio
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse CreateStudio)))
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 -> Int -> CreateStudioResponse
CreateStudioResponse'
            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
"StudioId")
            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
"Url")
            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 CreateStudio where
  hashWithSalt :: Int -> CreateStudio -> Int
hashWithSalt Int
_salt CreateStudio' {[Text]
Maybe [Tag]
Maybe Text
Text
AuthMode
defaultS3Location :: Text
engineSecurityGroupId :: Text
workspaceSecurityGroupId :: Text
serviceRole :: Text
subnetIds :: [Text]
vpcId :: Text
authMode :: AuthMode
name :: Text
userRole :: Maybe Text
tags :: Maybe [Tag]
idpRelayStateParameterName :: Maybe Text
idpAuthUrl :: Maybe Text
description :: Maybe Text
$sel:defaultS3Location:CreateStudio' :: CreateStudio -> Text
$sel:engineSecurityGroupId:CreateStudio' :: CreateStudio -> Text
$sel:workspaceSecurityGroupId:CreateStudio' :: CreateStudio -> Text
$sel:serviceRole:CreateStudio' :: CreateStudio -> Text
$sel:subnetIds:CreateStudio' :: CreateStudio -> [Text]
$sel:vpcId:CreateStudio' :: CreateStudio -> Text
$sel:authMode:CreateStudio' :: CreateStudio -> AuthMode
$sel:name:CreateStudio' :: CreateStudio -> Text
$sel:userRole:CreateStudio' :: CreateStudio -> Maybe Text
$sel:tags:CreateStudio' :: CreateStudio -> Maybe [Tag]
$sel:idpRelayStateParameterName:CreateStudio' :: CreateStudio -> Maybe Text
$sel:idpAuthUrl:CreateStudio' :: CreateStudio -> Maybe Text
$sel:description:CreateStudio' :: CreateStudio -> Maybe Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
description
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
idpAuthUrl
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
idpRelayStateParameterName
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [Tag]
tags
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
userRole
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
name
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` AuthMode
authMode
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
vpcId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` [Text]
subnetIds
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
serviceRole
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
workspaceSecurityGroupId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
engineSecurityGroupId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
defaultS3Location

instance Prelude.NFData CreateStudio where
  rnf :: CreateStudio -> ()
rnf CreateStudio' {[Text]
Maybe [Tag]
Maybe Text
Text
AuthMode
defaultS3Location :: Text
engineSecurityGroupId :: Text
workspaceSecurityGroupId :: Text
serviceRole :: Text
subnetIds :: [Text]
vpcId :: Text
authMode :: AuthMode
name :: Text
userRole :: Maybe Text
tags :: Maybe [Tag]
idpRelayStateParameterName :: Maybe Text
idpAuthUrl :: Maybe Text
description :: Maybe Text
$sel:defaultS3Location:CreateStudio' :: CreateStudio -> Text
$sel:engineSecurityGroupId:CreateStudio' :: CreateStudio -> Text
$sel:workspaceSecurityGroupId:CreateStudio' :: CreateStudio -> Text
$sel:serviceRole:CreateStudio' :: CreateStudio -> Text
$sel:subnetIds:CreateStudio' :: CreateStudio -> [Text]
$sel:vpcId:CreateStudio' :: CreateStudio -> Text
$sel:authMode:CreateStudio' :: CreateStudio -> AuthMode
$sel:name:CreateStudio' :: CreateStudio -> Text
$sel:userRole:CreateStudio' :: CreateStudio -> Maybe Text
$sel:tags:CreateStudio' :: CreateStudio -> Maybe [Tag]
$sel:idpRelayStateParameterName:CreateStudio' :: CreateStudio -> Maybe Text
$sel:idpAuthUrl:CreateStudio' :: CreateStudio -> Maybe Text
$sel:description:CreateStudio' :: CreateStudio -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
description
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
idpAuthUrl
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
idpRelayStateParameterName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [Tag]
tags
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
userRole
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
name
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf AuthMode
authMode
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
vpcId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf [Text]
subnetIds
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
serviceRole
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
workspaceSecurityGroupId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
engineSecurityGroupId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
defaultS3Location

instance Data.ToHeaders CreateStudio where
  toHeaders :: CreateStudio -> ResponseHeaders
toHeaders =
    forall a b. a -> b -> a
Prelude.const
      ( forall a. Monoid a => [a] -> a
Prelude.mconcat
          [ HeaderName
"X-Amz-Target"
              forall a. ToHeader a => HeaderName -> a -> ResponseHeaders
Data.=# ( ByteString
"ElasticMapReduce.CreateStudio" ::
                          Prelude.ByteString
                      ),
            HeaderName
"Content-Type"
              forall a. ToHeader a => HeaderName -> a -> ResponseHeaders
Data.=# ( ByteString
"application/x-amz-json-1.1" ::
                          Prelude.ByteString
                      )
          ]
      )

instance Data.ToJSON CreateStudio where
  toJSON :: CreateStudio -> Value
toJSON CreateStudio' {[Text]
Maybe [Tag]
Maybe Text
Text
AuthMode
defaultS3Location :: Text
engineSecurityGroupId :: Text
workspaceSecurityGroupId :: Text
serviceRole :: Text
subnetIds :: [Text]
vpcId :: Text
authMode :: AuthMode
name :: Text
userRole :: Maybe Text
tags :: Maybe [Tag]
idpRelayStateParameterName :: Maybe Text
idpAuthUrl :: Maybe Text
description :: Maybe Text
$sel:defaultS3Location:CreateStudio' :: CreateStudio -> Text
$sel:engineSecurityGroupId:CreateStudio' :: CreateStudio -> Text
$sel:workspaceSecurityGroupId:CreateStudio' :: CreateStudio -> Text
$sel:serviceRole:CreateStudio' :: CreateStudio -> Text
$sel:subnetIds:CreateStudio' :: CreateStudio -> [Text]
$sel:vpcId:CreateStudio' :: CreateStudio -> Text
$sel:authMode:CreateStudio' :: CreateStudio -> AuthMode
$sel:name:CreateStudio' :: CreateStudio -> Text
$sel:userRole:CreateStudio' :: CreateStudio -> Maybe Text
$sel:tags:CreateStudio' :: CreateStudio -> Maybe [Tag]
$sel:idpRelayStateParameterName:CreateStudio' :: CreateStudio -> Maybe Text
$sel:idpAuthUrl:CreateStudio' :: CreateStudio -> Maybe Text
$sel:description:CreateStudio' :: CreateStudio -> Maybe Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"Description" 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
description,
            (Key
"IdpAuthUrl" 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
idpAuthUrl,
            (Key
"IdpRelayStateParameterName" 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
idpRelayStateParameterName,
            (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 [Tag]
tags,
            (Key
"UserRole" 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
userRole,
            forall a. a -> Maybe a
Prelude.Just (Key
"Name" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
name),
            forall a. a -> Maybe a
Prelude.Just (Key
"AuthMode" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= AuthMode
authMode),
            forall a. a -> Maybe a
Prelude.Just (Key
"VpcId" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
vpcId),
            forall a. a -> Maybe a
Prelude.Just (Key
"SubnetIds" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= [Text]
subnetIds),
            forall a. a -> Maybe a
Prelude.Just (Key
"ServiceRole" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
serviceRole),
            forall a. a -> Maybe a
Prelude.Just
              ( Key
"WorkspaceSecurityGroupId"
                  forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
workspaceSecurityGroupId
              ),
            forall a. a -> Maybe a
Prelude.Just
              ( Key
"EngineSecurityGroupId"
                  forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
engineSecurityGroupId
              ),
            forall a. a -> Maybe a
Prelude.Just
              (Key
"DefaultS3Location" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
defaultS3Location)
          ]
      )

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

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

-- | /See:/ 'newCreateStudioResponse' smart constructor.
data CreateStudioResponse = CreateStudioResponse'
  { -- | The ID of the Amazon EMR Studio.
    CreateStudioResponse -> Maybe Text
studioId :: Prelude.Maybe Prelude.Text,
    -- | The unique Studio access URL.
    CreateStudioResponse -> Maybe Text
url :: Prelude.Maybe Prelude.Text,
    -- | The response's http status code.
    CreateStudioResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (CreateStudioResponse -> CreateStudioResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateStudioResponse -> CreateStudioResponse -> Bool
$c/= :: CreateStudioResponse -> CreateStudioResponse -> Bool
== :: CreateStudioResponse -> CreateStudioResponse -> Bool
$c== :: CreateStudioResponse -> CreateStudioResponse -> Bool
Prelude.Eq, ReadPrec [CreateStudioResponse]
ReadPrec CreateStudioResponse
Int -> ReadS CreateStudioResponse
ReadS [CreateStudioResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CreateStudioResponse]
$creadListPrec :: ReadPrec [CreateStudioResponse]
readPrec :: ReadPrec CreateStudioResponse
$creadPrec :: ReadPrec CreateStudioResponse
readList :: ReadS [CreateStudioResponse]
$creadList :: ReadS [CreateStudioResponse]
readsPrec :: Int -> ReadS CreateStudioResponse
$creadsPrec :: Int -> ReadS CreateStudioResponse
Prelude.Read, Int -> CreateStudioResponse -> ShowS
[CreateStudioResponse] -> ShowS
CreateStudioResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateStudioResponse] -> ShowS
$cshowList :: [CreateStudioResponse] -> ShowS
show :: CreateStudioResponse -> String
$cshow :: CreateStudioResponse -> String
showsPrec :: Int -> CreateStudioResponse -> ShowS
$cshowsPrec :: Int -> CreateStudioResponse -> ShowS
Prelude.Show, forall x. Rep CreateStudioResponse x -> CreateStudioResponse
forall x. CreateStudioResponse -> Rep CreateStudioResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CreateStudioResponse x -> CreateStudioResponse
$cfrom :: forall x. CreateStudioResponse -> Rep CreateStudioResponse x
Prelude.Generic)

-- |
-- Create a value of 'CreateStudioResponse' 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:
--
-- 'studioId', 'createStudioResponse_studioId' - The ID of the Amazon EMR Studio.
--
-- 'url', 'createStudioResponse_url' - The unique Studio access URL.
--
-- 'httpStatus', 'createStudioResponse_httpStatus' - The response's http status code.
newCreateStudioResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  CreateStudioResponse
newCreateStudioResponse :: Int -> CreateStudioResponse
newCreateStudioResponse Int
pHttpStatus_ =
  CreateStudioResponse'
    { $sel:studioId:CreateStudioResponse' :: Maybe Text
studioId = forall a. Maybe a
Prelude.Nothing,
      $sel:url:CreateStudioResponse' :: Maybe Text
url = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:CreateStudioResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | The ID of the Amazon EMR Studio.
createStudioResponse_studioId :: Lens.Lens' CreateStudioResponse (Prelude.Maybe Prelude.Text)
createStudioResponse_studioId :: Lens' CreateStudioResponse (Maybe Text)
createStudioResponse_studioId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateStudioResponse' {Maybe Text
studioId :: Maybe Text
$sel:studioId:CreateStudioResponse' :: CreateStudioResponse -> Maybe Text
studioId} -> Maybe Text
studioId) (\s :: CreateStudioResponse
s@CreateStudioResponse' {} Maybe Text
a -> CreateStudioResponse
s {$sel:studioId:CreateStudioResponse' :: Maybe Text
studioId = Maybe Text
a} :: CreateStudioResponse)

-- | The unique Studio access URL.
createStudioResponse_url :: Lens.Lens' CreateStudioResponse (Prelude.Maybe Prelude.Text)
createStudioResponse_url :: Lens' CreateStudioResponse (Maybe Text)
createStudioResponse_url = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateStudioResponse' {Maybe Text
url :: Maybe Text
$sel:url:CreateStudioResponse' :: CreateStudioResponse -> Maybe Text
url} -> Maybe Text
url) (\s :: CreateStudioResponse
s@CreateStudioResponse' {} Maybe Text
a -> CreateStudioResponse
s {$sel:url:CreateStudioResponse' :: Maybe Text
url = Maybe Text
a} :: CreateStudioResponse)

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

instance Prelude.NFData CreateStudioResponse where
  rnf :: CreateStudioResponse -> ()
rnf CreateStudioResponse' {Int
Maybe Text
httpStatus :: Int
url :: Maybe Text
studioId :: Maybe Text
$sel:httpStatus:CreateStudioResponse' :: CreateStudioResponse -> Int
$sel:url:CreateStudioResponse' :: CreateStudioResponse -> Maybe Text
$sel:studioId:CreateStudioResponse' :: CreateStudioResponse -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
studioId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
url
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus